<mdl.int>/print.mid.340

   1 TITLE   PRINTER ROUTINE FOR MUDDLE
   2
   3 RELOCATABLE
   4
   5 .INSRT DSK:MUDDLE >
   6
   7 .GLOBAL IPNAME,MTYO,RLOOKU,RADX,INAME,INTFCN,LINLN,DOIOTO,BFCLS1,ATOSQ,IGVAL
   8 .GLOBAL BYTPNT,OPNCHN,CHRWRD,IDVAL,CHARGS,CHFRM,CHLOCI,PRNTYP,PRTYPE,IBLOCK,WXCT
   9 .GLOBAL VECBOT,VAL,ITEM,INDIC,IOINS,DIRECT,TYPVEC,CHRPOS,LINPOS,ACCESS,PAGLN,ROOT,PROCID
  10 .GLOBAL BADCHN,WRONGD,CHNCLS,IGET,FNFFL,ILLCHO,BUFSTR,BYTDOP,6TOCHS,PURVEC,STBL,RXCT
  11 .GLOBAL TMPLNT,TD.LNT,BADTPL,MPOPJ,SSPEC1,GLOTOP,GTLPOS,SPSTOR,PVSTOR
  12 .GLOBAL CIPRIN,CIPRNC,CIPRN1,CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR
  13 .GLOBAL CIFLTZ,CITERP,CIUPRS,CPCH,CPCH1,CICRLF,NONSPC
  14
  15 BUFLNT==100             ; BUFFER LENGTH IN WORDS
  16
  17 FLAGS==0        ;REGISTER USED TO STORE FLAGS
  18 CARRET==15      ;CARRIAGE RETURN CHARACTER
  19 ESCHAR=="\      ;ESCAPE CHARACTER
  20 SPACE==40       ;SPACE CHARACTER
  21 ATMBIT==200000  ;BIT SWITCH FOR ATOM-NAME PRINT
  22 NOQBIT==020000  ;SWITCH FOR NO ESCAPING OF OUTPUT (PRINC)
  23 SEGBIT==010000  ;SWITCH TO INDICATE PRINTING A SEGMENT
  24 SPCBIT==004000  ;SWITCH TO INDICATE "PRINT" CALL (PUT A SPACE AFTER)
  25 FLTBIT==002000  ;SWITCH TO INDICATE "FLATSIZE" CALL
  26 HSHBIT==001000  ;SWITCH TO INDICATE "PHASH" CALL
  27 TERBIT==000400  ;SWITCH TO INDICATE "TERPRI" CALL
  28 UNPRSE==000200  ;SWITCH TO INDICATE "UNPARSE" CALL
  29 ASCBIT==000100  ;SWITCH TO INDICATE USING A "PRINT" CHANNEL
  30 BINBIT==000040  ;SWITCH TO INDICATE USING A "PRINTB" CHANNEL
  31 CNTLPC==000020  ;SWITCH TO INDICATE USING ^P CODE IOT
  32 PJBIT==400000
  33 C.BUF==1
  34 C.PRIN==2
  35 C.BIN==4
  36 C.OPN==10
  37 C.READ==40
  38
  39
  40 \fMFUNCTION      FLATSIZE,SUBR
  41         DEFINE FLTMAX
  42                 4(B) TERMIN
  43         DEFINE FLTSIZ
  44                 2(B)TERMIN
  45 ;FLATSIZE TAKES TWO OR THREE ARGUMENTS: THE FIRST IS AN OBJECT THE SECOND
  46 ;IS THE MAXIMUM SIZE BEFORE IT GIVES UP AN RETURNS FALSE
  47 ;THE THIRD (OPTIONAL) ARGUMENT IS A RADIX
  48         ENTRY
  49         CAMG    AB,[-2,,0]      ;CHECK NUMBER OF ARGS
  50         CAMG    AB,[-6,,0]
  51         JRST    WNA
  52         PUSH    P,3(AB)
  53
  54         GETYP   A,2(AB)
  55         CAIE    A,TFIX
  56         JRST    WTYP2           ;SECOND ARG NOT FIX THEN LOSE
  57 \r       CAMG    AB,[-4,,0]      ;SEE IF THERE IS A RADIX ARGUMENT
  58         JRST    .+3             ; RADIX SUPPLIED
  59         PUSHJ   P,GTRADX        ; GET THE RADIX FROM OUTCHAN
  60         JRST    FLTGO
  61         GETYP   A,4(AB)         ;CHECK TO SEE THAT RADIX IS FIX
  62         CAIE    A,TFIX
  63         JRST    WTYP            ;ERROR THIRD ARGUMENT WRONG TYPE
  64         MOVE    C,5(AB)
  65         PUSHJ   P,GETARG        ; GET ARGS INTO A AND B
  66 FLTGO:  POP     P,D             ; RESTORE FLATSIZE MAXIMUM
  67         PUSHJ   P,CIFLTZ
  68         JFCL
  69         JRST    FINIS
  70
  71
  72
  73 MFUNCTION UNPARSE,SUBR
  74         DEFINE UPB
  75                 0(B) TERMIN
  76
  77         ENTRY
  78
  79         JUMPGE  AB,TFA
  80         MOVE    E,TP            ;SAVE TP POINTER
  81
  82
  83
  84 ;TURN ON FLTBIT TO AVOID PRINTING LOSSAGE
  85 ;TURN ON UNPRSE TO CAUSE CHARS TO BE STASHED
  86         CAMG    AB,[-2,,0]      ;SKIP IF RADIX SUPPLIED
  87         JRST    .+3
  88         PUSHJ   P,GTRADX        ;GET THE RADIX FROM OUTCHAN
  89         JRST    UNPRGO
  90         CAMGE   AB,[-5,,0]      ;CHECK FOR TOO MANY
  91         JRST    TMA
  92         GETYP   0,2(AB)
  93         CAIE    0,TFIX          ;SEE IF RADIX IS FIXED
  94         JRST    WTYP2
  95         MOVE    C,3(AB)         ;GET RADIX\r
  96         PUSHJ   P,GETARG        ;GET ARGS INTO A AND B
  97 UNPRGO: PUSHJ   P,CIUPRS
  98         JRST    FINIS
  99         JRST    FINIS
 100
 101
 102 GTRADX: MOVE    B,IMQUOTE OUTCHAN
 103         PUSH    P,0             ;SAVE FLAGS
 104         PUSHJ   P,IDVAL         ;GET VALUE FOR OUTCHAN
 105         POP     P,0
 106         GETYP   A,A             ;CHECK TYPE OF CHANNEL
 107         CAIE    A,TCHAN
 108         JRST    FUNCH1-1        ;IT IS A TP-POINTER
 109         MOVE    C,RADX(B)       ;GET RADIX FROM OUTCHAN
 110         JRST    FUNCH1
 111         MOVE    C,(B)+6         ;GET RADIX FROM STACK
 112
 113 FUNCH1: CAIG    C,1             ;CHECK FOR STRANGE RADIX
 114         MOVEI   C,10.           ;DEFAULT IF THIS IS THE CASE
 115 GETARG: MOVE    A,(AB)
 116         MOVE    B,1(AB)
 117         POPJ    P,
 118
 119
 120 IMFUNCTION      PRINT,SUBR
 121         ENTRY
 122         PUSHJ   P,AGET          ; GET ARGS
 123         PUSHJ   P,CIPRIN
 124         JRST    FINIS
 125
 126 MFUNCTION       PRINC,SUBR
 127         ENTRY
 128         PUSHJ   P,AGET          ; GET ARGS
 129         PUSHJ   P,CIPRNC
 130         JRST    FINIS
 131
 132 MFUNCTION       PRIN1,SUBR
 133         ENTRY
 134         PUSHJ   P,AGET
 135         PUSHJ   P,CIPRN1
 136         JRST    FINIS
 137
 138
 139 MFUNCTION CRLF,SUBR
 140         ENTRY
 141         PUSHJ   P,AGET1
 142         PUSHJ   P,CICRLF
 143         JRST    FINIS
 144
 145 MFUNCTION       TERPRI,SUBR
 146         ENTRY
 147         PUSHJ   P,AGET1
 148         PUSHJ   P,CITERP
 149         JRST    FINIS
 150
 151 \f
 152 CICRLF: SKIPA   E,.
 153 CITERP: MOVEI   E,0
 154         SUBM    M,(P)
 155         MOVSI   0,TERBIT+SPCBIT ; SET UP FLAGS
 156         PUSH    P,E
 157         PUSHJ   P,TESTR         ; TEST FOR GOOD CHANNEL
 158         MOVEI   A,CARRET        ; MOVE IN CARRIAGE-RETURN
 159         PUSHJ   P,PITYO         ; PRINT IT OUT
 160         MOVEI   A,12            ; LINE-FEED
 161         PUSHJ   P,PITYO
 162         POP     P,0
 163         JUMPN   0,.+4
 164         MOVSI   A,TFALSE        ; RETURN A FALSE
 165         MOVEI   B,0
 166         JRST    MPOPJ           ; RETURN
 167
 168         MOVSI   A,TATOM
 169         MOVE    B,IMQUOTE T
 170         JRST    MPOPJ
 171
 172 TESTR:  GETYP   E,A
 173         CAIN    E,TCHAN         ; CHANNEL?
 174         JRST    TESTR1          ; OK?
 175         CAIE    E,TTP
 176         JRST    BADCHN
 177         HLRZS   0
 178         IOR     0,A             ; RESTORE FLAGS
 179         HRLZS   0
 180         POPJ    P,
 181 TESTR1: HRRZ    E,-2(B)         ; GET IN FLAGS FROM CHANNEL
 182         SKIPN   IOINS(B)
 183         PUSHJ   P,OPENIT
 184         TRNN    E,C.OPN         ; SKIP IF OPEN
 185         JRST    CHNCLS
 186         TRC     E,C.PRIN+C.OPN  ; CHECK TO SEE THAT CHANNEL IS GOOD
 187         TRNE    E,C.PRIN+C.OPN
 188         JRST    BADCHN          ; ITS A LOSER
 189         TRNE    E,C.BIN
 190         JRST    PSHNDL          ; DON'T HANDLE BINARY
 191         TLO     ASCBIT          ; ITS ASCII
 192         POPJ    P,              ; ITS A WINNER
 193
 194 PSHNDL: PUSH    TP,C            ; SAVE ARGS
 195         PUSH    TP,D
 196         PUSH    TP,A            ; PUSH CHANNEL ONTO STACK
 197         PUSH    TP,B
 198         PUSHJ   P,BPRINT        ; CHECK BUFFER
 199         POP     TP,B
 200         POP     TP,A
 201         POP     TP,D
 202         POP     TP,C
 203         POPJ    P,
 204
 205
 206 \f;CIUPRS NEEDS A RADIX IN C AND A TYPE-OBJECT PAIR IN A,B
 207
 208 CIUPRS: SUBM    M,(P)           ; MODIFY M-POINTER
 209         MOVE    E,TP            ; SAVE TP-POINTER
 210         PUSH    TP,[0]          ; SLOT FOR FIRST STRING COPY
 211         PUSH    TP,[0]
 212         PUSH    TP,[0]          ; AND SECOND STRING
 213         PUSH    TP,[0]
 214         PUSH    TP,A            ; SAVE OBJECTS
 215         PUSH    TP,B
 216         PUSH    TP,$TTP         ; SAVE TP POINTER
 217         PUSH    TP,E
 218         PUSH    P,C
 219         MOVE    D,[377777,,-1]  ; MOVE IN MAXIMUM NUMBER FOR FLATSIZE
 220         PUSHJ   P,CIFLTZ        ; FIND LENGTH OF STRING
 221         FATAL UNPARSE BLEW IT
 222         MOVEI   A,4(B)
 223         PUSH    P,B
 224         IDIVI   A,5
 225         PUSHJ   P,IBLOCK        ; GET A BLOCK
 226         POP     P,A
 227         HRLI    A,TCHSTR
 228         HRLI    B,010700
 229         SUBI    B,1
 230         POP     TP,E            ; RESTORE TP-POINTER
 231         SUB     TP,[1,,1]       ;GET RID OF TYPE WORD
 232         MOVEM   A,1(E)          ; SAVE RESULTS
 233         MOVEM   A,3(E)
 234         MOVEM   B,2(E)
 235         MOVEM   B,4(E)
 236         POP     TP,B            ; RESTORE THE WORLD
 237         POP     TP,A
 238         POP     P,C
 239         MOVSI   0,FLTBIT+UNPRSE ; SET UP FLAGS
 240         PUSHJ   P,CUSET
 241         JRST    MPOPJ           ; RETURN
 242
 243
 244
 245 ; FOR CIFLTZ C CONTAINS THE RADIX, D THE MAXIMUM NUMBER OF CHARACTERS,
 246 ; A,B THE TYPE-OBJECT PAIR
 247
 248 CIFLTZ: SUBM    M,(P)
 249         MOVE    E,TP            ; SAVE POINTER
 250         PUSH    TP,$TFIX        ; PUSH ON FLATSIZE COUNT
 251         PUSH    TP,[0]
 252         PUSH    TP,$TFIX        ; PUSH ON FLATSIZE MAXIMUM
 253         PUSH    TP,D
 254         MOVSI   0,FLTBIT        ; MOVE ON FLATSIZE FLAG
 255         PUSHJ   P,CUSET         ; CONTINUE
 256         JRST    MPOPJ
 257         SOS     (P)             ; SKIP RETURN
 258         JRST    MPOPJ           ; RETURN
 259
 260 ; CUSET IS THE ROUTINE USED BY FLATSIZE AND UNPARSE TO DO THE PUSHING,POPING AND CALLING
 261 ; NEEDED TO GET A RESULT.
 262
 263 CUSET:  PUSH    TP,$TFIX        ; PUSH ON RADIX
 264         PUSH    TP,C
 265         PUSH    TP,$TPDL
 266         PUSH    TP,P            ; PUSH ON RETURN POINTER IN CASE FLATSIZE GETS A FALSE
 267         PUSH    TP,A            ; SAVE OBJECTS
 268         PUSH    TP,B
 269         MOVSI   C,TTP           ; CONSTRUCT TP-POINTER
 270         HLR     C,FLAGS         ; SAVE FLAGS IN TP-POINTER
 271         MOVE    D,E
 272         PUSH    TP,C            ; PUSH ON CHANNEL
 273         PUSH    TP,D
 274         PUSHJ   P,IPRINT        ; GO TO INTERNAL PRINTER
 275         POP     TP,B            ; GET IN TP POINTER
 276         MOVE    TP,B            ; RESTORE POINTER
 277         TLNN    FLAGS,UNPRSE    ; SEE IF UNPARSE CALL
 278         JRST    FLTGEN          ; ITS A FLATSIZE
 279         MOVE    A,UPB+3         ; RETURN STRING
 280         MOVE    B,UPB+4
 281         POPJ    P,              ; DONE
 282 FLTGEN: MOVE    A,FLTSIZ-1      ; GET IN COUNT
 283         MOVE    B,FLTSIZ
 284         AOS     (P)
 285         POPJ    P,              ; EXIT
 286
 287 \f
 288 ; CIPRIN,CIPRNC,CIPRN1,CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR ALL ASSUME
 289 ; THAT C,D CONTAIN THE OBJECT AND A AND B CONTAIN THE CHANNEL
 290
 291 CIPRIN: SUBM    M,(P)
 292         MOVSI   0,SPCBIT        ; SET UP FLAGS
 293         PUSHJ   P,TPRT          ; PRINT INITIALIZATION
 294         PUSHJ   P,IPRINT
 295         JRST    TPRTE           ; EXIT
 296
 297 CIPRN1: SUBM    M,(P)
 298         MOVEI   FLAGS,0         ; SET UP FLAGS
 299         PUSHJ   P,TPR1          ; INITIALIZATION
 300         PUSHJ   P,IPRINT        ; PRINT IT OUT
 301         JRST    TPR1E           ; EXIT
 302
 303 CIPRNC: SUBM    M,(P)
 304         MOVSI   FLAGS,NOQBIT    ; SET UP FLAGS
 305         PUSHJ   P,TPR1          ; INITIALIZATION
 306         PUSHJ   P,IPRINT
 307         JRST    TPR1E           ; EXIT
 308 \f
 309 ; INITIALIZATION FOR PRINT ROUTINES
 310
 311 TPRT:   PUSHJ   P,TESTR         ; SEE IF CHANNEL IS OK
 312         PUSH    TP,C            ; SAVE ARGUMENTS
 313         PUSH    TP,D
 314         PUSH    TP,A            ; SAVE CHANNEL
 315         PUSH    TP,B
 316         MOVEI   A,CARRET        ; PRINT CARRIAGE RETURN
 317         PUSHJ   P,PITYO
 318         MOVEI   A,12            ; AND LF
 319         PUSHJ   P,PITYO
 320         MOVE    A,-3(TP)        ; MOVE IN ARGS
 321         MOVE    B,-2(TP)
 322         POPJ    P,
 323
 324 ; EXIT FOR PRINT ROUTINES
 325
 326 TPRTE:  POP     TP,B            ; RESTORE CHANNEL
 327         MOVEI   A,SPACE         ; PRINT TRAILING SPACE
 328         PUSHJ   P,PITYO
 329         SUB     TP,[1,,1]       ; GET RID OF CHANNEL TYPE-WORD
 330         POP     TP,B            ; RETURN WHAT WAS PASSED
 331         POP     TP,A
 332         JRST    MPOPJ           ; EXIT
 333
 334 ; INITIALIZATION FOR PRIN1 AND PRINC ROUTINES
 335
 336 TPR1:   PUSHJ   P,TESTR         ; SEE IF CHANNEL IS OK
 337         PUSH    TP,C            ; SAVE ARGS
 338         PUSH    TP,D
 339         PUSH    TP,A            ; SAVE CHANNEL
 340         PUSH    TP,B
 341         MOVE    A,-3(TP)                ; GET ARGS
 342         MOVE    B,-2(TP)
 343         POPJ    P,
 344
 345 ; EXIT FOR PRIN1 AND PRINC ROUTINES
 346
 347 TPR1E:  SUB     TP,[2,,2]       ; REMOVE CHANNEL
 348         POP     TP,B            ; RETURN ARGUMENTS THAT WERE GIVEN
 349         POP     TP,A
 350         JRST    MPOPJ           ; EXIT
 351
 352
 353 \f
 354 CPATM:  SUBM    M,(P)
 355         MOVSI   C,TATOM         ; GET TYPE FOR BINARY
 356         MOVEI   0,SPCBIT        ; SET UP FLAGS
 357         PUSHJ   P,TPRT          ; PRINT INITIALIZATION
 358         PUSHJ   P,CPATOM        ; PRINT IT OUT
 359         JRST    TPRTE           ; EXIT
 360
 361 CP1ATM: SUBM    M,(P)
 362         MOVE    C,$TATOM
 363         MOVEI   FLAGS,0         ; SET UP FLAGS
 364         PUSHJ   P,TPR1          ; INITIALIZATION
 365         PUSHJ   P,CPATOM        ; PRINT IT OUT
 366         JRST    TPR1E           ; EXIT
 367
 368 CPCATM: SUBM    M,(P)
 369         MOVE    C,$TATOM
 370         MOVSI   FLAGS,NOQBIT    ; SET UP FLAGS
 371         PUSHJ   P,TPR1          ; INITIALIZATION
 372         PUSHJ   P,CPATOM        ; PRINT IT OUT
 373         JRST    TPR1E           ; EXIT
 374
 375
 376 ; THIS ROUTINE IS USD TO PRINT ONE CHARACTER. THE CHANNEL IS IN A AND B THE
 377 ; CHARACTER IS IN C.
 378 CPCH1:  TDZA    0,0
 379 CPCH:   MOVEI   0,1
 380         SUBM    M,(P)
 381         PUSH    P,0
 382         MOVSI   FLAGS,NOQBIT
 383         MOVE    C,$TCHRS
 384         PUSHJ   P,TESTR         ; SEE IF CHANNEL IS GOOD
 385         EXCH    D,(P)           ; CHAR TO STACK, IND TO D
 386         MOVE    A,(P)           ; MOVE IN CHARACTER FOR PITYO
 387         JUMPE   D,.+3
 388         PUSHJ   P,PRETIF
 389         JRST    .+2
 390         PUSHJ   P,PITYO
 391         MOVE    A,$TCHRST       ; RETURN THE CHARACTER
 392         POP     P,B
 393         JRST    MPOPJ
 394
 395
 396
 397
 398 CPSTR:  SUBM    M,(P)
 399         HRLI    C,TCHSTR
 400         MOVSI   0,SPCBIT        ; SET UP FLAGS
 401         PUSHJ   P,TPRT          ; PRINT INITIALIZATION
 402         PUSHJ   P,CPCHST        ; PRINT IT OUT
 403         JRST    TPRTE           ; EXIT
 404
 405 CP1STR: SUBM    M,(P)
 406         HRLI    C,TCHSTR
 407         MOVEI   FLAGS,0         ; SET UP FLAGS
 408         PUSHJ   P,TPR1          ; INITIALIZATION
 409         PUSHJ   P,CPCHST        ; PRINT IT OUT
 410         JRST    TPR1E           ; EXIT
 411
 412 CPCSTR: SUBM    M,(P)
 413         HRLI    C,TCHSTR
 414         MOVSI   FLAGS,NOQBIT    ; SET UP FLAGS
 415         PUSHJ   P,TPR1          ; INITIALIZATION
 416         PUSHJ   P,CPCHST        ; PRINT IT OUT
 417         JRST    TPR1E           ; EXIT
 418
 419
 420 CPATOM: PUSH    TP,A            ; COPY ARGS FOR INTERNAL SAKE\r
 421         PUSH    TP,B
 422         PUSH    P,0             ; ATOM CALLER ROUTINE
 423         PUSH    P,C
 424         JRST    PATOM
 425
 426 CPCHST: PUSH    TP,A            ; COPY ARGS FOR INTERNAL SAKE\r
 427         PUSH    TP,B
 428         PUSH    P,0             ; STRING CALLER ROUTINE
 429         PUSH    P,C
 430         JRST    PCHSTR
 431
 432
 433 \f\r
 434 AGET:   MOVEI   FLAGS,0
 435         SKIPL   E,AB            ; COPY ARG POINTER
 436         JRST    TFA             ;NO ARGS IS AN ERROR
 437         ADD     E,[2,,2]        ;POINT AT POSSIBLE CHANNEL
 438         JRST    COMPT
 439 AGET1:  MOVE    E,AB            ; GET COPY OF AB
 440         MOVSI   FLAGS,TERBIT
 441
 442 COMPT:  PUSH    TP,$TFIX        ;LEAVE ROOM ON STACK FOR ONE CHANNEL
 443         PUSH    TP,[0]
 444         JUMPGE  E,DEFCHN        ;IF NO CHANNEL ARGUMENT, USE CURRENT BINDING
 445         CAMG    E,[-2,,0]       ;IF MORE ARGS THEN ERROR
 446         JRST    TMA
 447         MOVE    A,(E)           ;GET CHANNEL
 448         MOVE    B,(E)+1
 449         JRST    NEWCHN
 450
 451 DEFCHN: MOVE    B,IMQUOTE OUTCHAN
 452         MOVSI   A,TATOM
 453         PUSH    P,FLAGS         ;SAVE FLAGS
 454         PUSHJ   P,IDVAL         ;GET VALUE OF OUTCHAN
 455         POP     P,0
 456
 457 NEWCHN: TLNE    FLAGS,TERBIT    ; SEE IF TERPRI
 458         POPJ    P,
 459         MOVE    C,(AB)  ; GET ARGS
 460         MOVE    D,1(AB)
 461         POPJ    P,
 462
 463 ; HERE IF USING A PRINTB CHANNEL
 464
 465 BPRINT: TLO     FLAGS,BINBIT
 466         SKIPE   BUFSTR(B)       ; ANY OUTPUT BUFFER?
 467         POPJ    P,
 468
 469 ; HERE TO GENERATE A STRING BUFFER
 470
 471         PUSH    P,FLAGS
 472         MOVEI   A,BUFLNT        ; GET BUFFER LENGTH
 473         PUSHJ   P,IBLOCK        ; MAKE A BUFFER
 474         MOVSI   0,TWORD+.VECT.  ; CLOBBER U TYPE
 475         MOVEM   0,BUFLNT(B)
 476         SETOM   (B)             ; -1 THE BUFFER
 477         MOVEI   C,1(B)
 478         HRLI    C,(B)
 479         BLT     C,BUFLNT-1(B)
 480         HRLI    B,010700
 481         SUBI    B,1
 482         MOVE    C,(TP)
 483         MOVEM   B,BUFSTR(C)     ; STOR BYTE POINTER
 484         MOVE    0,[TCHSTR,,BUFLNT*5]
 485         MOVEM   0,BUFSTR-1(C)
 486         POP     P,FLAGS
 487         MOVE    B,(TP)
 488         POPJ    P,
 489 \f
 490
 491 IPRINT: PUSH    P,C             ; SAVE C
 492         PUSH    P,FLAGS ;SAVE PREVIOUS FLAGS
 493         PUSH    TP,A    ;SAVE ARGUMENT ON TP-STACK
 494         PUSH    TP,B
 495
 496         INTGO           ;ALLOW INTERRUPTS HERE
 497
 498         GETYP   A,-1(TP)        ;GET THE TYPE CODE OF THE ITEM
 499         SKIPE   C,PRNTYP+1      ; USER TYPE TABLE?
 500         JRST    PRDISP
 501 NORMAL: CAILE   A,NUMPRI        ;PRIMITIVE?
 502         JRST    PUNK            ;JUMP TO ERROR ROUTINE IF CODE TOO GREAT
 503         HRRO    A,PRTYPE(A)     ;YES-DISPATCH
 504         JRST    (A)
 505
 506 ; HERE FOR USER PRINT DISPATCH
 507
 508 PRDISP: ADDI    C,(A)           ; POINT TO SLOT
 509         ADDI    C,(A)
 510         SKIPE   (C)             ; SKIP EITHER A LOSER OR JRST DISP
 511         JRST    PRDIS1          ; APPLY EVALUATOR
 512         SKIPN   C,1(C)          ; GET ADDR OR GO TO PURE DISP
 513         JRST    NORMAL
 514         JRST    (C)
 515
 516 PRDIS1: SUB     C,PRNTYP+1
 517         PUSH    P,C
 518         PUSH    TP,[TATOM,,-1]  ; PUSH ON OUTCHAN FOR SPECBIND
 519         PUSH    TP,IMQUOTE OUTCHAN
 520         PUSH    TP,-5(TP)
 521         PUSH    TP,-5(TP)
 522         PUSH    TP,[0]
 523         PUSH    TP,[0]
 524         PUSHJ   P,SPECBIND
 525         POP     P,C             ; RESTORE C
 526         ADD     C,PRNTYP+1              ; RESTORE C
 527         PUSH    TP,(C)          ; PUSH ARGS FOR APPLY
 528         PUSH    TP,1(C)
 529         PUSH    TP,-9(TP)
 530         PUSH    TP,-9(TP)
 531         MCALL   2,APPLY         ; APPLY HACKER TO OBJECT
 532         MOVEI   E,-8(TP)
 533         PUSHJ   P,SSPEC1        ;UNBIND OUTCHAN
 534         SUB     TP,[6,,6]       ; POP OFF STACK
 535         JRST    PNEXT
 536
 537 ; PRINT DISPATCH TABLE
 538
 539 IF2,PUNKS==400000,,PUNK
 540
 541 DISTBL  PRTYPE,PUNKS,[[TATOM,PATOM],[TFORM,PFORM],[TSEG,PSEG],[TFIX,PFIX]
 542 [TFLOAT,PFLOAT],[TLIST,PLIST],[TVEC,PVEC],[TCHRS,PCHRS],[TCHSTR,PCHSTR]
 543 [TARGS,PARGS],[TUVEC,PUVEC],[TDEFER,PDEFER],[TINTH,PINTH],[THAND,PHAND]
 544 [TILLEG,ILLCH],[TRSUBR,PRSUBR],[TENTER,PENTRY],[TPCODE,PPCODE],[TTYPEW,PTYPEW]
 545 [TTYPEC,PTYPEC],[TTMPLT,TMPRNT],[TLOCD,LOCPT1],[TLOCR,LOCRPT],[TQRSUB,PRSUBR]
 546 [TQENT,PENTRY],[TSATC,PSATC],[TBYTE,PBYTE]
 547 [TOFFS,POFFSE]]
 548
 549 PUNK:   MOVE    C,TYPVEC+1      ; GET AOBJN-POINTER TO VECTOR OF TYPE ATOMS
 550         GETYP   B,-1(TP)        ; GET THE TYPE CODE INTO REG B
 551         LSH     B,1             ; MULTIPLY BY TWO
 552         HRL     B,B             ; DUPLICATE IT IN THE LEFT HALF
 553         ADD     C,B             ; INCREMENT THE AOBJN-POINTER
 554         JUMPGE  C,PRERR         ; IF POSITIVE, INDEX > VECTOR SIZE
 555
 556         MOVE    B,-2(TP)                ; MOVE IN CHANNEL
 557         PUSH    TP,$TVEC                ; SAVE ALLTYPES VECTOR
 558         PUSH    TP,C
 559         PUSHJ   P,RETIF1        ; START NEW LINE IF NO ROOM
 560         MOVEI   A,"#            ; INDICATE TYPE-NAME FOLLOWS
 561         PUSHJ   P,PITYO
 562         POP     TP,C
 563         SUB     TP,[1,,1]
 564         MOVE    A,(C)           ; GET TYPE-ATOM
 565         MOVE    B,1(C)
 566         PUSH    TP,-3(TP)               ; GET CHANNEL FOR IPRINT
 567         PUSH    TP,-3(TP)
 568         PUSHJ   P,IPRINT        ; PRINT ATOM-NAME
 569         SUB     TP,[2,,2]       ; POP STACK
 570         MOVE    B,-2(TP)                ; MOVE IN CHANNEL
 571         PUSHJ   P,SPACEQ        ;  MAYBE SPACE
 572         MOVE    B,(B)           ; RESET THE REAL ARGUMENT POINTER
 573         HRRZ    A,(C)           ; GET THE STORAGE-TYPE
 574         ANDI    A,SATMSK
 575         CAILE   A,NUMSAT        ; SKIP IF TEMPLATE
 576         JRST    TMPRNT          ; PRINT TEMPLATED DATA STRUCTURE
 577         HRRO    A,UKTBL(A)      ; USE DISPATCH TABLE ON STORAGE TYPE
 578         JRST    (A)
 579
 580 DISTBS  UKTBL,POCTAL,[[S2WORD,PLIST],[S2NWORD,PVEC],[SNWORD,PUVEC],[SATOM,PATOM]
 581 [SCHSTR,PCHSTR],[SFRAME,PFRAME],[SARGS,PARGS],[SPVP,PPVP],[SLOCID,LOCPT],[SLOCA,LOCP]
 582 [SLOCV,LOCP],[SLOCU,LOCP],[SLOCS,LOCP],[SLOCL,LOCP],[SLOCN,LOCP],[SASOC,ASSPNT]
 583 [SLOCT,LOCP],[SLOCB,LOCP],[SBYTE,PBYTE],[SOFFS,POFFSE]]
 584         ; SELECK AN ILLEGAL
 585
 586 ILLCH:  MOVEI   B,-1(TP)
 587         JRST    ILLCHO
 588
 589 \f; PRINT INTERRUPT HANDLER
 590
 591 PHAND:  MOVE    B,-2(TP)        ; MOVE CHANNEL INTO B
 592         PUSHJ   P,RETIF1
 593         MOVEI   A,"#
 594         PUSHJ   P,PITYO         ; SAY "FUNNY TYPE"
 595         MOVSI   A,TATOM
 596         MOVE    B,MQUOTE HANDLER
 597         PUSH    TP,-3(TP)       ; PUSH CHANNEL ON FOR IPRINT
 598         PUSH    TP,-3(TP)
 599         PUSHJ   P,IPRINT                ; PRINT THE TYPE NAME
 600         SUB     TP,[2,,2]               ; POP CHANNEL OFF STACK
 601         MOVE    B,-2(TP)        ; GET CHANNEL
 602         PUSHJ   P,SPACEQ                ; SPACE MAYBE
 603         SKIPN   B,(TP)          ; GET ARG BACK
 604         JRST    PNEXT
 605         MOVE    A,INTFCN(B)     ; PRINT FUNCTION FOR NOW
 606         MOVE    B,INTFCN+1(B)
 607         PUSH    TP,-3(TP)               ; GET CHANNEL FOR IPRINT
 608         PUSH    TP,-3(TP)
 609         PUSHJ   P,IPRINT        ; PRINT THE INT FUNCTION
 610         SUB     TP,[2,,2]       ; POP CHANNEL OFF
 611         JRST    PNEXT
 612
 613 ; PRINT INT HEADER
 614
 615 PINTH:  MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 616         PUSHJ   P,RETIF1
 617         MOVEI   A,"#
 618         PUSHJ   P,PITYO
 619         MOVSI   A,TATOM         ; AND NAME
 620         MOVE    B,MQUOTE IHEADER
 621         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
 622         PUSH    TP,-3(TP)
 623         PUSHJ   P,IPRINT
 624         MOVE    B,-4(TP)        ; GET CHANNEL INTO B
 625         PUSHJ   P,SPACEQ        ; MAYBE SPACE
 626         SKIPN   B,-2(TP)                ; INT HEADER BACK
 627         JRST    PINTH1
 628         MOVE    A,INAME(B)      ; GET NAME
 629         MOVE    B,INAME+1(B)
 630         PUSHJ   P,IPRINT
 631 PINTH1: SUB     TP,[2,,2]       ; CLEAN OFF STACK
 632         JRST    PNEXT
 633
 634
 635 ; PRINT ASSOCIATION BLOCK
 636
 637 ASSPNT: MOVEI   A,"(            ; MAKE IT BE (ITEN INDIC VAL)
 638         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 639         PUSHJ   P,PRETIF                ; MAKE ROOM AND PRINT
 640         SKIPA   C,[-3,,0]       ; # OF FIELDS
 641 ASSLP:  PUSHJ   P,SPACEQ
 642         MOVE    D,(TP)          ; RESTORE GOODIE
 643         ADD     D,ASSOFF(C)     ; POINT TO FIELD
 644         MOVE    A,(D)           ; GET IT
 645         MOVE    B,1(D)
 646         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
 647         PUSH    TP,-3(TP)
 648         PUSHJ   P,IPRINT        ; AND PRINT IT
 649         SUB     TP,[2,,2]       ; POP OFF CHANNEL
 650         MOVE    B,-2(TP)        ; GET CHANNEL
 651         AOBJN   C,ASSLP
 652
 653         MOVEI   A,")
 654         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 655         PUSHJ   P,PRETIF        ; CLOSE IT
 656         JRST    PNEXT
 657
 658 ASSOFF: ITEM
 659         INDIC
 660         VAL
 661 \f; PRINT TYPE-C AND TYPE-W
 662
 663 PTYPEW: HRRZ    A,(TP)  ; POSSIBLE RH
 664         HLRZ    B,(TP)
 665         MOVE    C,MQUOTE TYPE-W
 666         JRST    PTYPEX
 667
 668 PTYPEC: HRRZ    B,(TP)
 669         MOVEI   A,0
 670         MOVE    C,MQUOTE TYPE-C
 671
 672 PTYPEX: PUSH    P,B
 673         PUSH    P,A
 674         PUSH    TP,$TATOM
 675         PUSH    TP,C
 676         MOVEI   A,2
 677         MOVE    B,-4(TP)        ; GET CHANNEL INTO B
 678         PUSHJ   P,RETIF         ; ROOM TO START?
 679         MOVEI   A,"%
 680         PUSHJ   P,PITYO
 681         MOVEI   A,"<
 682         PUSHJ   P,PITYO
 683         POP     TP,B            ; GET NAME
 684         POP     TP,A
 685         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
 686         PUSH    TP,-3(TP)
 687         PUSHJ   P,IPRINT        ; AND PRINT IT AS 1ST ELEMENT
 688         SUB     TP,[2,,2]       ; POP OFF CHANNEL
 689         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 690         PUSHJ   P,SPACEQ        ; MAYBE SPACE
 691         MOVE    A,-1(P)         ; TYPE CODE
 692         ASH     A,1
 693         HRLI    A,(A)           ; MAKE SURE WINS
 694         ADD     A,TYPVEC+1
 695         JUMPL   A,PTYPX1        ; JUMP FOR A WINNER
 696         ERRUUO  EQUOTE BAD-TYPE-CODE
 697
 698 PTYPX1: MOVE    B,1(A)          ; GET TYPE NAME
 699         HRRZ    A,(A)           ; AND SAT
 700         ANDI    A,SATMSK
 701         MOVEM   A,-1(P)         ; AND SAVE IT
 702         MOVSI   A,TATOM
 703         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
 704         PUSH    TP,-3(TP)
 705         PUSHJ   P,IPRINT        ; OUT IT GOES
 706         SUB     TP,[2,,2]       ; POP OFF CHANNEL
 707         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 708         PUSHJ   P,SPACEQ        ; MAYBE SPACE
 709         MOVE    A,-1(P)         ; GET SAT BACK
 710         MOVE    B,IMQUOTE TEMPLATE
 711         CAIGE   A,NUMSAT
 712         MOVE    B,@STBL(A)
 713         MOVSI   A,TATOM         ; AND PRINT IT
 714         PUSH    TP,-3(TP)               ; GET CHANNEL FOR IPRINT
 715         PUSH    TP,-3(TP)
 716         PUSHJ   P,IPRINT
 717         SUB     TP,[2,,2]       ; POP OFF STACK
 718         SKIPN   B,(P)           ; ANY EXTRA CRAP?
 719         JRST    PTYPX2
 720
 721         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 722         PUSHJ   P,SPACEQ
 723         MOVE    B,(P)
 724         MOVSI   A,TFIX
 725         PUSH    TP,-3(TP)       ; PUSH CHANNELS FOR IPRINT
 726         PUSH    TP,-3(TP)
 727         PUSHJ   P,IPRINT        ; PRINT EXTRA
 728         SUB     TP,[2,,2]       ; POP OFF CHANNEL
 729
 730 PTYPX2: MOVEI   A,">
 731         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 732         PUSHJ   P,PRETIF
 733         SUB     P,[2,,2]        ; FLUSH CRUFT
 734         JRST    PNEXT
 735
 736 \f; PRIMTYPE CODE
 737
 738 ; PRINT PURE CODE POINTER
 739
 740 PSATC:  MOVEI   A,2
 741         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 742         PUSHJ   P,RETIF
 743         MOVEI   A,"%
 744         PUSHJ   P,PITYO
 745         MOVEI   A,"<
 746         PUSHJ   P,PITYO
 747         MOVSI   A,TATOM         ; PRINT SUBR CALL
 748         MOVE    B,MQUOTE PRIMTYPE-C
 749         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
 750         PUSH    TP,-3(TP)
 751         PUSHJ   P,IPRINT
 752         MOVE    B,-4(TP)        ; GET CHANNEL INTO B
 753         PUSHJ   P,SPACEQ        ; MAYBE SPACE?
 754         MOVE    A,-2(TP)
 755         CAILE   A,NUMSAT
 756         JRST    TMPPTY
 757
 758         MOVE    B,@STBL(A)
 759         JRST    PSATC1
 760
 761 TMPPTY: MOVE    B,TYPVEC+1
 762 PSATC3: HRRZ    C,(B)
 763         ANDI    C,SATMSK
 764         CAIN    A,(C)
 765         JRST    PSATC2
 766         ADD     B,[2,,2]
 767         JUMPL   B,PSATC3
 768
 769         ERRUUO  EQUOTE BAD-PRIMTYPEC
 770
 771 PSATC2: MOVE    B,1(B)
 772 PSATC1: MOVSI   A,TATOM
 773         PUSHJ   P,IPRINT
 774         SUB     TP,[2,,2]
 775         MOVEI   A,">
 776         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 777         PUSHJ   P,PRETIF        ; CLOSE THE FORM
 778         JRST    PNEXT
 779
 780
 781 PPCODE: MOVEI   A,2
 782         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 783         PUSHJ   P,RETIF
 784         MOVEI   A,"%
 785         PUSHJ   P,PITYO
 786         MOVEI   A,"<
 787         PUSHJ   P,PITYO
 788         MOVSI   A,TATOM         ; PRINT SUBR CALL
 789         MOVE    B,MQUOTE PCODE
 790         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
 791         PUSH    TP,-3(TP)
 792         PUSHJ   P,IPRINT
 793         MOVE    B,-4(TP)        ; GET CHANNEL INTO B
 794         PUSHJ   P,SPACEQ        ; MAYBE SPACE?
 795         HLRZ    A,-2(TP)                ; OFFSET TO VECTOR
 796         ADD     A,PURVEC+1      ; SLOT TO A
 797         MOVE    A,(A)           ; SIXBIT NAME
 798         PUSH    P,FLAGS
 799         PUSHJ   P,6TOCHS        ; TO A STRING
 800         POP     P,FLAGS
 801         PUSHJ   P,IPRINT
 802         MOVE    B,-4(TP)        ; GET CHANNEL INTO B
 803         PUSHJ   P,SPACEQ
 804         HRRZ    B,-2(TP)        ; GET OFFSET
 805         MOVSI   A,TFIX\r
 806         PUSHJ   P,IPRINT
 807         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
 808         MOVEI   A,">
 809         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 810         PUSHJ   P,PRETIF        ; CLOSE THE FORM
 811         JRST    PNEXT
 812
 813
 814 \f; PRINT SUB-ENTRY TO RSUBR
 815
 816 PENTRY: MOVE    B,(TP)          ; GET BLOCK
 817         GETYP   A,(B)           ; TYPE OF 1ST ELEMENT
 818         CAIE    A,TRSUBR        ; RSUBR, OK
 819         JRST    PENT1
 820 PENT2:  MOVEI   A,2             ; CHECK ROOM
 821         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 822         PUSHJ   P,RETIF
 823         MOVEI   A,"%            ; SETUP READ TIME MACRO
 824         PUSHJ   P,PITYO
 825         MOVEI   A,"<
 826         PUSHJ   P,PITYO
 827         MOVSI   A,TATOM
 828         MOVE    B,IMQUOTE RSUBR-ENTRY
 829         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
 830         PUSH    TP,-3(TP)
 831         PUSHJ   P,IPRINT
 832         MOVE    B,-4(TP)
 833         PUSHJ   P,SPACEQ        ; MAYBE SPACE
 834         MOVEI   A,"'            ; QUOTE TO AVOID EVALING IT
 835         PUSHJ   P,PRETIF
 836         MOVEI   A,"[            ; OPEN SQUARE BRAKET
 837         PUSHJ   P,PRETIF
 838         MOVE    B,-2(TP)
 839         GETYP   A,(B)
 840         CAIN    A,TRSUBR
 841         JRST    PENT3
 842         MOVE    A,(B)
 843         MOVE    B,1(B)
 844         PUSHJ   P,IPRINT
 845         MOVE    B,-4(TP)                ; MOVE IN CHANNEL
 846         JRST    PENT4
 847 PENT3:  MOVE    A,1(B)
 848         MOVE    B,3(A)
 849         MOVSI   A,TATOM         ; FOOL EVERYBODY AND SEND OUT ATOM
 850         PUSHJ   P,IPRINT
 851         MOVE    B,-4(TP)                ; PRINT SPACE
 852 PENT4:  PUSHJ   P,SPACEQ
 853         MOVE    B,-2(TP)                ; GET PTR BACK TO VECTOR
 854         MOVE    A,2(B)          ; THE NAME OF THE ENTRY
 855         MOVE    B,3(B)
 856         PUSHJ   P,IPRINT        ; OUT IT GOES
 857         CAMLE   B,[-4,,-1]      ; SEE IF DONE
 858         JRST    EXPEN
 859         MOVE    B,-4(TP)                ; PRINT SPACE
 860         PUSHJ   P,SPACEQ
 861         MOVE    B,-2(TP)        ; GET POINTER
 862         MOVE    A,4(B)          ; DECL
 863         MOVE    B,5(B)
 864         PUSHJ   P,IPRINT
 865         MOVE    B,-4(TP)        ; GET CHANNEL INTO B
 866 EXPEN:  MOVEI   A,"]            ; CLOSE SQUARE BRAKET
 867         PUSHJ   P,PRETIF
 868         MOVE    B,-4(TP)                ; GET CHANNEL INTO B
 869         PUSHJ   P,SPACEQ
 870         MOVE    B,-2(TP)
 871         HRRZ    B,2(B)
 872         MOVSI   A,TFIX
 873         PUSHJ   P,IPRINT
 874         MOVEI   A,">
 875         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
 876         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 877         PUSHJ   P,PRETIF
 878         JRST    PNEXT
 879
 880 PENT1:  CAIN    A,TATOM
 881         JRST    PENT2
 882         ERRUUO  EQUOTE BAD-ENTRY-BLOCK
 883
 884 \f; HERE TO PRINT TEMPLATED DATA STRUCTURE
 885
 886 TMPRNT: PUSH    P,FLAGS         ; SAVE FLAGS
 887         MOVE    A,(TP)          ; GET POINTER
 888         GETYP   A,(A)           ; GET SAT
 889         PUSH    P,A             ; AND SAVE IT
 890         MOVEI   A,"{            ; OPEN SQUIGGLE
 891         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 892         PUSHJ   P,PRETIF        ; PRINT WITH CHECKING
 893         HLRZ    A,(TP)          ; GET AMOUNT RESTED OFF
 894         SUBI    A,1
 895         PUSH    P,A             ; AND SAVE IT
 896         MOVE    A,-1(P)         ; GET SAT
 897         SUBI    A,NUMSAT+1      ; FIXIT UP
 898         HRLI    A,(A)
 899         ADD     A,TD.LNT+1      ; CHECK FOR WINNAGE
 900         JUMPGE  A,BADTPL        ; COMPLAIN
 901         HRRZS   C,(TP)          ; GET LENGTH
 902         XCT     (A)             ;  INTO B
 903         SUB     B,(P)           ; FUDGE FOR RESTS
 904         MOVEI   B,-1(B)         ; FUDGE IT
 905         PUSH    P,B             ; AND SAVE IT
 906
 907 TMPRN1: AOS     C,-1(P)         ; GET ELEMENT OF INTEREST
 908         SOSGE   (P)             ; CHECK FOR ANY LEFT
 909         JRST    TMPRN2          ; ALL DONE
 910
 911         MOVE    B,(TP)          ; POINTER
 912         HRRZ    0,-2(P)         ; SAT
 913         PUSHJ   P,TMPLNT        ; GET THE ITEM
 914         MOVE    FLAGS,-3(P)     ; RESTORE FLAGS
 915         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
 916         PUSH    TP,-3(TP)
 917         PUSHJ   P,IPRINT        ; PRINT THIS ELEMENT
 918         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
 919         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
 920         SKIPE   (P)             ; IF NOT LAST ONE THEN
 921         PUSHJ   P,SPACEQ        ;   SEPARATE WITH A SPACE
 922         JRST    TMPRN1
 923
 924 TMPRN2: SUB     P,[4,,4]
 925         MOVE    B,-2(TP)
 926         MOVEI   A,"}            ; CLOSE THIS GUY
 927         PUSHJ   P,PRETIF
 928         JRST    PNEXT
 929
 930
 931 \f; RSUBR PRINTING ROUTINES.  ON PRINTB CHANNELS, WRITES OUT
 932 ; COMPACT BINARY.  ON PRINT CHANNELS ALL IS ASCII
 933
 934 PRSUBR: MOVE    A,(TP)          ; GET RSUBR IN QUESTION
 935         GETYP   A,(A)           ; CHECK FOR PURE RSUBR
 936         CAIN    A,TPCODE
 937         JRST    PRSBRP          ; PRINT IT SPECIAL WAY
 938
 939         TLNN    FLAGS,BINBIT    ; SKIP IF BINARY OUTPUT
 940         JRST    ARSUBR
 941
 942         PUSH    P,FLAGS
 943         MOVSI   A,TRSUBR        ; FIND FIXUPS
 944         MOVE    B,(TP)
 945         HLRE    D,1(B)          ; -LENGTH OF CODE VEC
 946         PUSH    P,D             ; SAVE SAME
 947         MOVSI   C,TATOM
 948         MOVE    D,IMQUOTE RSUBR
 949         PUSHJ   P,IGET          ; GO GET THEM
 950         JUMPE   B,RCANT         ; NO FIXUPS, BINARY LOSES
 951         PUSH    TP,A            ; SAVE FIXUP LIST
 952         PUSH    TP,B
 953
 954         MOVNI   A,1             ; USE ^C AS MARKER FOR RSUBR
 955         MOVE    FLAGS,-1(P)     ; RESTORE FLAGS
 956         MOVE    B,-4(TP)        ; GET CHANNEL FOR PITYO
 957         PUSHJ   P,PITYO         ; OUT IT GOES
 958
 959 PRSBR1: MOVE    B,-4(TP)
 960         PUSHJ   P,BFCLS1        ; FLUSH OUT CURRENT BUFFER
 961
 962         MOVE    B,-4(TP)                ; CHANNEL BACK
 963         MOVN    E,(P)           ; LENGTH OF CODE
 964         PUSH    P,E
 965         HRROI   A,(P)           ; POINT TO SAME
 966         PUSHJ   P,DOIOTO        ; OUT GOES COUNT
 967         MOVSI   C,TCODE
 968         MOVE    PVP,PVSTOR+1
 969         MOVEM   C,ASTO(PVP)     ; FOR IOT INTERRUPTS
 970         MOVE    A,-2(TP)        ; GET POINTER TO CODE
 971         MOVE    A,1(A)
 972         PUSHJ   P,DOIOTO        ; IOT IT OUT
 973         POP     P,E
 974         ADDI    E,1             ; UPDATE ACCESS
 975         ADDM    E,ACCESS(B)
 976         MOVE    PVP,PVSTOR+1
 977         SETZM   ASTO(PVP)       ; UNSCREW A
 978
 979 ; NOW PRINT OUT NORMAL RSUBR VECTOR
 980
 981         MOVE    FLAGS,-1(P)     ; RESTORE FLAGS
 982         SUB     P,[1,,1]
 983         MOVE    B,-2(TP)        ; GET RSUBR VECTOR
 984         PUSHJ   P,PRBODY        ; PRINT ITS BODY
 985
 986 ; HERE TO PRINT BINARY FIXUPS
 987
 988         MOVEI   E,0             ; 1ST COMPUTE LENGTH OF FIXUPS
 989         SKIPN   A,(TP)  ; LIST TO A
 990         JRST    PRSBR5          ; EMPTY, DONE
 991         JUMPL   A,UFIXES        ; JUMP IF FIXUPS IN UVECTOR FORM
 992         ADDI    E,1             ; FOR VERS
 993
 994 PRSBR6: HRRZ    A,(A)           ; NEXT?
 995         JUMPE   A,PRSBR5
 996         GETYP   B,(A)
 997         CAIE    B,TDEFER        ; POSSIBLE STRING
 998         JRST    PRSBR7          ; COULD BE ATOM
 999         MOVE    B,1(A)          ; POSSIBLE STRINGER
1000         GETYP   C,(B)
1001         CAIE    C,TCHSTR        ; YES!!!
1002         JRST    BADFXU          ; LOSING FIXUPS
1003         HRRZ    C,(B)           ; # OF CHARS TO C
1004         ADDI    C,5+5           ; ROUND AND ADD FOR COUNT
1005         IDIVI   C,5             ; TO WORDS
1006         ADDI    E,(C)
1007         JRST    FIXLST          ; COUNT FOR USE LIST ETC.
1008
1009 PRSBR7: GETYP   B,(A)           ; GET TYPE
1010         CAIE    B,TATOM
1011         JRST    BADFXU
1012         ADDI    E,1
1013
1014 FIXLST: HRRZ    A,(A)           ; REST IT TO OLD VAL
1015         JUMPE   A,BADFXU
1016         GETYP   B,(A)           ; FIX?
1017         CAIE    B,TFIX
1018         JRST    BADFXU
1019         MOVEI   D,1
1020         HRRZ    A,(A)           ; TO USE LIST
1021         JUMPE   A,BADFXU
1022         GETYP   B,(A)
1023         CAIE    B,TLIST
1024         JRST    BADFXU          ; LOSER
1025         MOVE    C,1(A)          ; GET LIST
1026
1027 PRSBR8: JUMPE   C,PRSBR9
1028         GETYP   B,(C)           ; TYPE OK?
1029         CAIE    B,TFIX
1030         JRST    BADFXU
1031         HRRZ    C,(C)
1032         AOJA    D,PRSBR8        ; LOOP
1033
1034 PRSBR9: ADDI    D,2             ; ROUND UP
1035         ASH     D,-1            ; DIV BY 2 FOR TWO GOODIES PER HWORD
1036         ADDI    E,(D)
1037         JRST    PRSBR6
1038
1039 PRSBR5: PUSH    P,E             ; SAVE LENGTH OF FIXUPS
1040         PUSH    TP,$TUVEC       ; SLOT FOR BUFFER POINTER
1041         PUSH    TP,[0]
1042
1043 PFIXU1: MOVE    B,-6(TP)                ; START LOOPING THROUGH CHANNELS
1044         PUSHJ   P,BFCLS1        ; FLUSH BUFFER
1045         MOVE    B,-6(TP)                ; CHANNEL BACK
1046         MOVEI   C,BUFSTR-1(B)   ; SETUP BUFFER
1047         PUSHJ   P,BYTDOP        ; FIND D.W.
1048         SUBI    A,BUFLNT+1
1049         HRLI    A,-BUFLNT
1050         MOVEM   A,(TP)
1051         MOVE    E,(P)           ; LENGTH OF FIXUPS
1052         SETZB   C,D             ; FOR EOUT
1053         PUSHJ   P,EOUT
1054         MOVE    C,-2(TP)        ; FIXUP LIST
1055         MOVE    E,1(C)          ; HAVE VERS
1056         PUSHJ   P,EOUT          ; OUT IT GOES
1057
1058 PFIXU2: HRRZ    C,(C)           ; FIRST THING
1059         JUMPE   C,PFIXU3        ; DONE?
1060         GETYP   A,(C)           ; STRING OR ATOM
1061         CAIN    A,TATOM         ; MUST BE STRING
1062         JRST    PFIXU4
1063         MOVE    A,1(C)          ; POINT TO POINTER
1064         HRRZ    D,(A)           ; LENGTH
1065         IDIVI   D,5
1066         PUSH    P,E             ; SAVE REMAINDER
1067         MOVEI   E,1(D)
1068         MOVNI   D,(D)
1069         MOVSI   D,(D)
1070         PUSH    P,D
1071         PUSHJ   P,EOUT
1072         MOVEI   D,0
1073 PFXU1A: MOVE    A,1(C)          ; RESTORE POINTER
1074         HRRZ    A,1(A)          ; BYTE POINTER
1075         ADD     A,(P)
1076         MOVE    E,(A)
1077         PUSHJ   P,EOUT
1078         MOVE    A,[1,,1]
1079         ADDB    A,(P)
1080         JUMPL   A,PFXU1A
1081         MOVE    D,-1(P)         ; LAST WORD
1082         MOVE    A,1(C)
1083         HRRZ    A,1(A)
1084         ADD     A,(P)
1085         SKIPE   E,D
1086         MOVE    E,(A)           ; LAST WORD OF CHARS
1087         IOR     E,PADS(D)
1088         PUSHJ   P,EOUT          ; OUT
1089         SUB     P,[1,,1]
1090         JRST    PFIXU5
1091
1092 PADS:   ASCII /#####/
1093         ASCII /####/
1094         ASCII /\ 2###/
1095         ASCII /\ 2##/
1096         ASCII /\ 2\ 2#/
1097
1098 PFIXU4: HRRZ    E,(C)           ; GET CURRENT VAL
1099         MOVE    E,1(E)
1100         PUSHJ   P,ATOSQ         ; GET SQUOZE
1101         JRST    BADFXU
1102         TLO     E,400000        ; USE TO DIFFERENTIATE BETWEEN STRING
1103         PUSHJ   P,EOUT
1104
1105 ; HERE TO WRITE OUT LISTS
1106
1107 PFIXU5: HRRZ    C,(C)           ; POINT TO CURRENT VALUE
1108         HRLZ    E,1(C)
1109         HRRZ    C,(C)           ; POINT TO USES LIST
1110         HRRZ    D,1(C)          ; GET IT
1111
1112 PFIXU6: TLCE    D,400000        ; SKIP FOR RH
1113         HRLZ    E,1(D)          ; SETUP LH
1114         JUMPG   D,.+3
1115         HRR     E,1(D)
1116         PUSHJ   P,EOUT          ; WRITE IT OUT
1117         HRR     D,(D)
1118         TRNE    D,-1            ; SKIP IF DONE
1119         JRST    PFIXU6
1120
1121         TRNE    E,-1            ; SKIP IF ZERO BYTE EXISTS
1122         MOVEI   E,0
1123         PUSHJ   P,EOUT
1124         JRST    PFIXU2          ; DO NEXT
1125
1126 PFIXU3: HLRE    C,(TP)          ; -AMNT LEFT IN BUFFER
1127         MOVN    D,C             ; PLUS SAME
1128         ADDI    C,BUFLNT        ; WORDS USED TO C
1129         JUMPE   C,PFIXU7        ; NONE USED, LEAVE
1130         MOVSS   C               ; START SETTING UP BTB
1131         MOVN    A,C             ; ALSO FINAL IOT POINTER
1132         HRR     C,(TP)          ; PDL POINTER PART OF BTB
1133         SUBI    C,1
1134         HRLI    D,400000+C      ; CONTINUE SETTING UP BTB (400000 IS FOR MULTI
1135                                 ;       SEGS
1136         POP     C,@D            ; MOVE 'EM DOWN
1137         TLNE    C,-1
1138         JRST    .-2
1139         HRRI    A,@D            ; OUTPUT POINTER
1140         ADDI    A,1
1141         MOVSI   B,TUVEC
1142         MOVE    PVP,PVSTOR+1
1143         MOVEM   B,ASTO(PVP)
1144         MOVE    B,-6(TP)
1145         PUSHJ   P,DOIOTO        ; WRITE IT OUT
1146         MOVE    PVP,PVSTOR+1
1147         SETZM   ASTO(PVP)
1148
1149 PFIXU7:         SUB     TP,[4,,4]
1150         SUB     P,[2,,2]
1151         JRST    PNEXT
1152
1153 ; ROUTINE TO OUTPUT CONTENTS OF E
1154
1155 EOUT:   MOVE    B,-6(TP)        ; CHANNEL
1156         AOS     ACCESS(B)
1157         MOVE    A,(TP)          ; BUFFER POINTER
1158         MOVEM   E,(A)
1159         AOBJP   A,.+3           ; COUNT AND GO
1160         MOVEM   A,(TP)
1161         POPJ    P,
1162
1163         SUBI    A,BUFLNT        ; SET UP IOT POINTER
1164         HRLI    A,-BUFLNT
1165         MOVEM   A,(TP)          ; RESET SAVED POINTER
1166         MOVSI   0,TUVEC
1167         MOVE    PVP,PVSTOR+1
1168         MOVEM   0,ASTO(PVP)
1169         MOVSI   0,TLIST
1170         MOVEM   0,DSTO(PVP)
1171         MOVEM   0,CSTO(PVP)
1172         PUSHJ   P,DOIOTO        ; OUT IT GOES
1173         MOVE    PVP,PVSTOR+1
1174         SETZM   ASTO(PVP)
1175         SETZM   CSTO(PVP)
1176         SETZM   DSTO(PVP)
1177         POPJ    P,
1178
1179 ; HERE IF UVECOR FORM OF FIXUPS
1180
1181 UFIXES: PUSH    TP,$TUVEC
1182         PUSH    TP,A            ; SAVE IT
1183
1184 UFIX1:          MOVE    B,-6(TP)                ; GET SAME
1185         PUSHJ   P,BFCLS1        ; FLUSH OUT BUFFER
1186         HLRE    C,(TP)  ; GET LENGTH
1187         MOVMS   C
1188         PUSH    P,C
1189         HRROI   A,(P)           ; READY TO ZAP IT OUT
1190         PUSHJ   P,DOIOTO        ; ZAP!
1191         SUB     P,[1,,1]
1192         HLRE    C,(TP)          ; LENGTH BACK
1193         MOVMS   C
1194         ADDI    C,1
1195         ADDM    C,ACCESS(B)     ; UPDATE ACCESS
1196         MOVE    A,(TP)          ; NOW THE UVECTOR
1197         MOVSI   C,TUVEC
1198         MOVE    PVP,PVSTOR+1
1199         MOVEM   C,ASTO(PVP)
1200         PUSHJ   P,DOIOTO        ; GO
1201         MOVE    PVP,PVSTOR+1
1202         SETZM   ASTO(PVP)
1203         SUB     P,[1,,1]
1204         SUB     TP,[4,,4]
1205         JRST    PNEXT
1206
1207 RCANT:  ERRUUO  EQUOTE RSUBR-LACKS-FIXUPS
1208
1209
1210 BADFXU: ERRUUO  EQUOTE BAD-FIXUPS
1211
1212 PRBODY: TDZA    C,C             ; FLAG SAYING FLUSH CODE
1213 PRBOD1: MOVEI   C,1             ; PRINT CODE ALSO
1214         PUSH    P,FLAGS
1215         PUSH    TP,$TRSUBR
1216         PUSH    TP,B
1217         PUSH    P,C
1218         MOVEI   A,"[            ; START VECTOR TEXT
1219         MOVE    B,-6(TP)        ; GET CHANNEL FOR PITYO
1220         PUSHJ   P,PITYO
1221         POP     P,C
1222         MOVE    B,(TP)          ; RSUBR BACK
1223         JUMPN   C,PRSON         ; GO START PRINTING
1224         MOVEI   A,"0            ; PLACE SAVER FOR CODE VEC
1225         MOVE    B,-6(TP)        ; GET CHANNEL FOR PITYO
1226         PUSHJ   P,PITYO
1227
1228 PRSBR2: MOVE    B,[2,,2]        ; BUMP VECTOR
1229         ADDB    B,(TP)
1230         JUMPGE  B,PRSBR3        ; NO SPACE IF LAST
1231         MOVE    B,-6(TP)        ; GET CHANNEL FOR SPACEQ
1232         PUSHJ   P,SPACEQ
1233         SKIPA   B,(TP)          ; GET BACK POINTER
1234 PRSON:  JUMPGE  B,PRSBR3
1235         GETYP   0,(B)           ; SEE IF RSUBR POINTED TO
1236         CAIE    0,TQENT
1237         CAIN    0,TENTER
1238         JRST    .+5             ; JUMP IF RSUBR ENTRY
1239         CAIN    0,TQRSUB
1240         JRST    .+3
1241         CAIE    0,TRSUBR        ; YES!
1242         JRST    PRSB10          ; COULD BE SUBR/FSUBR
1243         MOVE    C,1(B)          ; GET RSUBR
1244         PUSH    P,0             ; SAVE TYPE FOUND
1245         GETYP   0,2(C)          ; SEE IF ATOM
1246         CAIE    0,TATOM
1247         JRST    PRSBR4
1248         MOVE    B,3(C)          ; GET ATOM NAME
1249         PUSHJ   P,IGVAL         ; GO LOOK
1250         MOVE    C,(TP)          ; ORIG RSUBR BACK
1251         GETYP   A,A
1252         POP     P,0             ; DESIRED TYPE
1253         CAIE    0,(A)           ; SAME TYPE
1254         JRST    PRSBR4
1255         MOVE    D,1(C)
1256         MOVE    0,3(D)          ; NAME OF RSUBR IN QUESTION
1257         CAME    0,3(B)          ; WIN?
1258         JRST    PRSBR4
1259         HRRZ    E,C
1260         MOVSI   A,TATOM
1261         MOVE    B,0             ; GET ATOM
1262         MOVE    FLAGS,(P)
1263         JRST    PRS101
1264
1265 PRSBR4: MOVE    FLAGS,(P)       ; RESTORE FLAGS
1266         MOVE    B,(TP)
1267         MOVE    A,(B)
1268         MOVE    B,1(B)          ; PRINT IT
1269 PRS101: PUSH    TP,-7(TP)       ; PUSH CHANNEL FOR IPRINT
1270         PUSH    TP,-7(TP)
1271         PUSHJ   P,IPRINT
1272         SUB     TP,[2,,2]       ; POP OFF CHANNEL
1273         MOVE    B,-2(TP)                ; MOVE IN CHANNEL
1274         JRST    PRSBR2
1275
1276 PRSB10: CAIE    0,TSUBR         ; SUBR?
1277         CAIN    0,TFSUBR
1278         JRST    .+2
1279         JRST    PRSBR4
1280         MOVE    C,1(B)          ; GET LOCN OF SUBR OR FSUBR
1281         MOVE    B,@-1(C)        ; NAME OF IT
1282         MOVSI   A,TATOM         ; AND TYPE
1283         JRST    PRS101
1284
1285 PRSBR3: MOVEI   A,"]
1286         MOVE    B,-6(TP)
1287         PUSHJ   P,PRETIF        ; CLOSE IT UP
1288         SUB     TP,[2,,2]       ; FLUSH CRAP
1289         POP     P,FLAGS
1290         POPJ    P,
1291
1292
1293 \f; HERE TO PRINT PURE RSUBRS
1294
1295 PRSBRP: MOVEI   A,2             ; WILL "%<" FIT?
1296         MOVE    B,-2(TP)        ; GET CHANNEL FOR RETIF
1297         PUSHJ   P,RETIF
1298         MOVEI   A,"%
1299         PUSHJ   P,PITYO
1300         MOVEI   A,"<
1301         PUSHJ   P,PITYO
1302         MOVSI   A,TATOM
1303         MOVE    B,IMQUOTE RSUBR
1304         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
1305         PUSH    TP,-3(TP)
1306         PUSHJ   P,IPRINT        ; PRINT IT OUT
1307         SUB     TP,[2,,2]       ; POP OFF CHANNEL
1308         MOVE    B,-2(TP)
1309         PUSHJ   P,SPACEQ        ; MAYBE SPACE
1310         MOVEI   A,"'            ; QUOTE THE VECCTOR
1311         PUSHJ   P,PRETIF
1312         MOVE    B,(TP)          ; GET RSUBR BODY BACK
1313         PUSH    TP,$TFIX                ; STUFF THE STACK
1314         PUSH    TP,[0]
1315         PUSHJ   P,PRBOD1        ; PRINT AND UNLINK
1316         SUB     TP,[2,,2]       ; GET JUNK OFF STACK
1317         MOVE    B,-2(TP)        ; GET CHANNEL FOR RETIF
1318         MOVEI   A,">
1319         PUSHJ   P,PRETIF
1320         JRST    PNEXT
1321
1322 ; HERE TO PRINT ASCII RSUBRS
1323
1324 ARSUBR: PUSH    P,FLAGS         ; SAVE FROM GET
1325         MOVSI   A,TRSUBR
1326         MOVE    B,(TP)
1327         MOVSI   C,TATOM
1328         MOVE    D,IMQUOTE RSUBR
1329         PUSHJ   P,IGET          ; TRY TO GET FIXUPS
1330         POP     P,FLAGS
1331         JUMPE   B,PUNK          ; NO FIXUPS LOSE
1332         GETYP   A,A
1333         CAIE    A,TLIST         ; ARE FIXUPS A LIST?
1334         JRST    PUNK            ; NO, AGAIN LOSE
1335         PUSH    TP,$TLIST
1336         PUSH    TP,B            ; SAVE FIXUPS
1337         MOVEI   A,17.
1338         MOVE    B,-4(TP)
1339         PUSHJ   P,RETIF
1340         PUSH    P,[440700,,[ASCIZ /%<FIXUP!-RSUBRS!-/]]
1341
1342 AL1:    ILDB    A,(P)           ; GET CHAR
1343         JUMPE   A,.+3
1344         PUSHJ   P,PITYO
1345         JRST    AL1
1346
1347         SUB     P,[1,,1]
1348         PUSHJ   P,SPACEQ
1349
1350         MOVEI   A,"'
1351         PUSHJ   P,PRETIF        ; QUOTE TO AVOID ADDITIONAL EVAL
1352         MOVE    B,-2(TP)        ; PRINT ACTUAL KLUDGE
1353         PUSHJ   P,PRBOD1
1354         MOVE    B,-4(TP)        ; GET CHANNEL FOR SPACEQ
1355         PUSHJ   P,SPACEQ
1356         MOVEI   A,"'            ; DONT EVAL FIXUPS EITHER
1357         PUSHJ   P,PRETIF
1358         POP     TP,B
1359         POP     TP,A
1360         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
1361         PUSH    TP,-3(TP)
1362         PUSHJ   P,IPRINT
1363         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
1364         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
1365         MOVEI   A,">
1366         PUSHJ   P,PRETIF
1367         JRST    PNEXT
1368 \f
1369 ; HERE TO DO OFFSETS:  %<OFFSET N '<VECTOR FIX FLOAT>>
1370
1371 POFFSE: MOVEI   A,2
1372         MOVE    B,-2(TP)
1373         PUSHJ   P,RETIF
1374         MOVEI   A,"%
1375         PUSHJ   P,PITYO
1376         MOVEI   A,"<
1377         PUSHJ   P,PITYO
1378         MOVSI   A,TATOM
1379         MOVE    B,MQUOTE OFFSET
1380         PUSH    TP,-3(TP)
1381         PUSH    TP,-3(TP)
1382         PUSHJ   P,IPRINT
1383         SUB     TP,[2,,2]
1384         MOVE    B,-2(TP)        ; RESTORE CHANNEL
1385         PUSHJ   P,SPACEQ
1386         MOVSI   A,TFIX
1387         HRRE    B,(TP)          ; PICK UPTHE FIX
1388         PUSH    TP,-3(TP)
1389         PUSH    TP,-3(TP)
1390         PUSHJ   P,IPRINT
1391         SUB     TP,[2,,2]
1392         MOVE    B,-2(TP)        ; RESTORE CHANNEL
1393         PUSHJ   P,SPACEQ
1394         HLRZ    A,(TP)
1395         JUMPE   A,POFFS2
1396         GETYP   B,(A)
1397         CAIE    B,TFORM         ; FORMS HAVE TO BE QUOTED
1398          JRST   POFFS1
1399         MOVEI   A,"'
1400         MOVE    B,-2(TP)
1401         PUSHJ   P,PRETIF
1402 POFFS1: HLRZ    B,(TP)
1403         MOVE    A,(B)
1404         MOVE    B,1(B)
1405 POFFPT: PUSH    TP,-3(TP)
1406         PUSH    TP,-3(TP)
1407         PUSHJ   P,IPRINT
1408         SUB     TP,[2,,2]
1409         MOVE    B,-2(TP)        ; RESTORE CHANNEL
1410         MOVEI   A,">
1411         PUSHJ   P,PRETIF
1412         JRST    PNEXT
1413 ; PRINT 'ANY' IF 0
1414 POFFS2: MOVSI   A,TATOM
1415         MOVE    B,IMQUOTE ANY
1416         JRST    POFFPT
1417
1418 \f; HERE TO DO LOCATIVES (PRINT CONTENTS THEREOF)
1419
1420 LOCP:   PUSH    TP,-1(TP)
1421         PUSH    TP,-1(TP)
1422         PUSH    P,0
1423         MCALL   1,IN            ; GET ITS CONTENTS FROM "IN"
1424         POP     P,0
1425         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
1426         PUSH    TP,-3(TP)
1427         PUSHJ   P,IPRINT        ; PRINT IT
1428         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
1429         JRST    PNEXT
1430 \f;INTERNAL SUBROUTINE TO HANDLE CHARACTER OUTPUT
1431 ;B CONTAINS CHANNEL
1432 ;PRINTER ITYO USED FOR FLATSIZE FAKE OUT
1433 PITYO:  TLNN    FLAGS,FLTBIT
1434         JRST    ITYO
1435 PITYO1: PUSH    TP,[TTP,,0]     ; PUSH ON TP POINTER
1436         PUSH    TP,B
1437         TLNE    FLAGS,UNPRSE    ;SKIPS UNPRSE NOT SET
1438         JRST    ITYO+2
1439         AOS     FLTSIZ  ;FLATSIZE DOESN'T PRINT
1440                         ;INSTEAD IT COUNTS THE CHARACTERS THAT WOULD BE OUTPUT
1441         SOSGE   FLTMAX  ;UNLESS THE MAXIMUM IS EXCEEDED
1442         JRST    .+4
1443         POP     TP,B            ; GET CHANNEL BACK
1444         SUB     TP,[1,,1]
1445         POPJ    P,
1446         MOVEI   E,(B)           ; GET POINTER FOR UNBINDING
1447         PUSHJ   P,SSPEC1
1448         MOVE    P,UPB+8         ; RESTORE P
1449         POP     TP,B            ; GET BACK TP POINTER
1450         PUSH    P,0             ; SAVE FLAGS
1451         MOVE    TP,B            ; RESTORE TP
1452         MOVEI   C,(TB)          ; SEE IF TB IS CORRECT
1453         CAIG    C,1(TP)         ; SKIP IF NEEDS UNWINDING
1454         JRST    PITYO4
1455 PITYO3: MOVEI   C,(TB)
1456         CAILE   C,1(TP)
1457         JRST    PITYO2
1458         MOVEI   A,PITYO4        ; SET UP PARAMETERS TO BE RESTORED BY FINIS
1459         HRRM    A,PCSAV(C)
1460         MOVEM   TP,TPSAV(C)
1461         MOVE    SP,SPSTOR+1
1462         MOVEM   SP,SPSAV(C)
1463         MOVEM   P,PSAV(C)
1464         MOVE    TB,D            ; SET TB TO ONE FRAME AHEAD
1465         JRST    FINIS
1466 PITYO4: POP     P,0             ; RESTORE FLAGS
1467         MOVSI   A,TFALSE        ;IN WHICH CASE IT IMMEDIATELY GIVES UP AND RETURNS FALSE
1468         MOVEI   B,0
1469         POPJ    P,
1470
1471 PITYO2: MOVE    D,TB            ; SAVE ONE FRAME AHEAD
1472         HRR     TB,OTBSAV(TB)   ; RESTORE TB
1473         JRST    PITYO3
1474
1475
1476 \f;THE REAL THING
1477 ;NOTE THAT THE FOLLOWING CODE HAS BUGS IF IT IS PRINTING OUT LONG
1478 ;CHARACTER STRINGS
1479 ; (NOTE THAT THE ABOVE COMMENT, IF TRUE, SHOULD NOT BE ADMITTED.)
1480 ITYO:   PUSH    TP,$TCHAN
1481         PUSH    TP,B
1482         PUSH    P,FLAGS         ;SAVE STUFF
1483         PUSH    P,C
1484         PUSH    P,A             ;SAVE OUTPUT CHARACTER
1485
1486
1487         TLNE    FLAGS,UNPRSE    ;SKIPS UNPRSE NOT SET
1488          JRST   UNPROUT         ;IF FROM UNPRSE, STASH IN STRING
1489         CAIN    A,^J
1490          PUSHJ  P,INTCHK
1491         PUSH    P,A
1492         PUSHJ   P,WXCT
1493         POP     P,A
1494         CAIE    A,^L            ;SKIP IF THIS IS A FORM-FEED
1495          JRST   NOTFF
1496         SETZM   LINPOS(B)       ;ZERO THE LINE NUMBER
1497         JRST    ITYXT
1498
1499 NOTFF:  CAIE    A,15            ;SKIP IF IT IS A CR
1500          JRST   NOTCR
1501         SETZM   CHRPOS(B)       ;ZERO THE CHARACTER POSITION
1502         PUSHJ   P,AOSACC        ; BUMP COUNT
1503         JRST    ITYXT1
1504
1505 NOTCR:  CAIN    A,^I            ;SKIP IF NOT TAB
1506          JRST   TABCNT
1507         CAIE    A,10            ; BACK SPACE
1508          JRST   .+3
1509         SOS     CHRPOS(B)       ; BACK UP ONE
1510         JRST    ITYXT
1511         CAIE    A,^J            ;SKIP IF LINE FEED
1512          JRST   NOTLF
1513         AOS     C,LINPOS(B)     ;ADD ONE TO THE LINE NUMBER
1514         CAMLE   C,PAGLN(B)      ;SKIP IF THIS DOESN'T TAKES US PAST PAGE END
1515          SETZM  LINPOS(B)
1516         MOVE    FLAGS,-2(P)
1517         JRST    ITYXT
1518
1519 INTCHK: HRRZ    0,-2(B)         ; GET CHANNELS FLAGS
1520         TRNN    0,C.INTL        ; LOSER INTERESTED IN LFS?
1521          POPJ   P,              ; LEAVE IF NOTHING TO DO
1522         PUSH    TP,$TCHAN
1523         PUSH    TP,B            ; SAVE CHANNEL
1524         PUSH    P,C
1525         PUSH    P,E
1526         PUSHJ   P,GTLPOS                ; READ SYSTEMS VERSION OF LINE #
1527         PUSH    TP,$TATOM
1528         PUSH    TP,MQUOTE CHAR,CHAR,INTRUP
1529         PUSH    TP,$TFIX
1530         PUSH    TP,A
1531         PUSH    TP,$TCHAN
1532         PUSH    TP,B
1533         MCALL   3,INTERRUPT
1534         POP     P,E             ; RESTORE POSSIBLE COUNTS
1535         POP     P,C
1536         POP     TP,B            ; RESTORE CHANNEL
1537         SUB     TP,[1,,1]
1538         MOVEI   A,^J
1539         POPJ    P,
1540
1541 NOTLF:  CAIGE   A,40
1542         AOS     CHRPOS(B)       ; FOR CONTROL CHARS THAT NEED 2 SPACES
1543         AOS     CHRPOS(B)       ;ADD TO CHARACTER NUMBER
1544
1545 ITYXT:  PUSHJ   P,AOSACC        ; BUMP ACCESS
1546 ITYXT1: POP     P,A             ;RESTORE THE ORIGINAL CHARACTER
1547
1548 ITYRET: POP     P,C             ;RESTORE REGS & RETURN
1549         POP     P,FLAGS
1550         POP     TP,B            ; GET CHANNEL BACK
1551         SUB     TP,[1,,1]
1552         POPJ    P,
1553
1554 TABCNT: PUSH    P,D
1555         MOVE    C,CHRPOS(B)
1556         ADDI    C,8.            ;INCREMENT COUNT BY EIGHT (MOD EIGHT)
1557         IDIVI   C,8.
1558         IMULI   C,8.
1559         MOVEM   C,CHRPOS(B)     ;REPLACE COUNT
1560         POP     P,D
1561         JRST    ITYXT
1562
1563 UNPROUT: POP    P,A     ;GET BACK THE ORIG CHAR
1564         IDPB    A,UPB+2         ;DEPOSIT USING BYTE POINTER I PUSHED LONG AGO
1565         SOS     UPB+1
1566         JRST    ITYRET  ;RETURN
1567
1568 AOSACC: TLNN    FLAGS,BINBIT
1569         JRST    NRMACC
1570         AOS     C,ACCESS-1(B)   ; COUNT CHARS IN WORD
1571         CAMN    C,[TFIX,,1]
1572         AOS     ACCESS(B)
1573         CAMN    C,[TFIX,,5]
1574         HLLZS   ACCESS-1(B)
1575         POPJ    P,
1576
1577 NRMACC: AOS     ACCESS(B)
1578         POPJ    P,
1579
1580 SPACEQ: MOVEI   A,40
1581         TLNE    FLAGS,FLTBIT+BINBIT
1582         JRST    PITYO           ; JUST OUTPUT THE SPACE
1583         PUSH    P,[1]           ; PRINT SPACE IF NOT END OF LINE
1584         MOVEI   A,1
1585         JRST    RETIF2
1586
1587 RETIF1: MOVEI   A,1
1588
1589 RETIF:  PUSH    P,[0]
1590         TLNE    FLAGS,FLTBIT+BINBIT
1591         JRST    SPOPJ           ; IF WE ARE IN FLATSIZE THEN ESCAPE
1592 RETIF2: PUSH    P,FLAGS
1593 RETCH:  PUSH    P,A
1594
1595 RETCH1: ADD     A,CHRPOS(B)     ;ADD THE CHARACTER POSITION
1596         SKIPN   CHRPOS(B)       ; IF JUST RESET, DONT DO IT AGAIN
1597         JRST    RETXT
1598         CAMG    A,LINLN(B)      ;SKIP IF GREATER THAN LINE LENGTH
1599         JRST    RETXT1
1600
1601         MOVEI   A,^M            ;FORCE A CARRIAGE RETURN
1602         SETZM   CHRPOS(B)
1603         PUSHJ   P,WXCT
1604         PUSHJ   P,AOSACC        ; BUMP CHAR COUNT
1605         MOVEI   A,^J            ;AND FORCE A LINE FEED
1606         PUSHJ   P,INTCHK        ; CHECK FOR ^J INTERRUPTS
1607         PUSHJ   P,WXCT
1608         PUSHJ   P,AOSACC        ; BUMP CHAR COUNT
1609         AOS     A,LINPOS(B)
1610         CAMG    A,PAGLN(B)      ;AT THE END OF THE PAGE ?
1611         JRST    RETXT
1612 ;       MOVEI   A,^L    ;IF SO FORCE A FORM FEED
1613 ;       PUSHJ   P,WXCT
1614 ;       PUSHJ   P,AOSACC        ; BUMP CHAR COUNT
1615         SETZM   LINPOS(B)
1616
1617 RETXT:  POP     P,A
1618
1619         POP     P,FLAGS
1620 SPOPJ:  SUB     P,[1,,1]
1621         POPJ    P,      ;RETURN
1622
1623 PRETIF: PUSH    P,A     ;SAVE CHAR
1624         PUSHJ   P,RETIF1
1625         POP     P,A
1626         JRST    PITYO
1627
1628 RETIF3: TLNE    FLAGS,FLTBIT    ; NOTHING ON FLATSIZE
1629         POPJ    P,
1630         PUSH    P,[0]
1631         PUSH    P,FLAGS
1632         HRRI    FLAGS,2         ; PRETEND ONLY 1 CHANNEL
1633         PUSH    P,A
1634         JRST    RETCH1
1635
1636 RETXT1: SKIPN   -2(P)           ; SKIP IF SPACE HACK
1637         JRST    RETXT
1638         MOVEI   A,40
1639         PUSHJ   P,WXCT
1640         AOS     CHRPOS(B)
1641         PUSH    P,C
1642         PUSHJ   P,AOSACC
1643         POP     P,C
1644         JRST    RETXT
1645
1646 \f;THIS IS CODE TO HANDLE UNKNOWN DATA TYPES.
1647 ;IT PRINTS "*XXXXXX*XXXXXXXXXXXX*", WHERE THE FIRST NUMBER IS THE
1648 ;TYPE CODE IN OCTAL, THE SECOND IS THE VALUE FIELD IN OCTAL.
1649 PRERR:  MOVEI   A,21.   ;CHECK FOR 21. SPACES LEFT ON PRINT LINE
1650         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
1651         PUSHJ   P,RETIF ;INSERT CARRIAGE RETURN IF NOT ENOUGH
1652         MOVEI   A,"*    ;JUNK TO INDICATE ERROR PRINTOUT IN OCTAL
1653         PUSHJ   P,PITYO ;TYPE IT
1654
1655         MOVE    E,[000300,,-2(TP)]      ;GET POINTER INDEXED OFF TP SO THAT
1656                                 ;TYPE CODE MAY BE OBTAINED FOR PRINTING.
1657         MOVEI   D,6     ;# OF OCTAL DIGITS IN HALF WORD
1658 OCTLP1: ILDB    A,E     ;GET NEXT 3-BIT BYTE OF TYPE CODE
1659         IORI    A,60    ;OR-IN 60 FOR ASCII DIGIT
1660         PUSHJ   P,PITYO ;PRINT IT
1661         SOJG    D,OCTLP1        ;REPEAT FOR SIX CHARACTERS
1662
1663 PRE01:  MOVEI   A,"*    ;DELIMIT TYPE CODE FROM VALUE FIELD
1664         PUSHJ   P,PITYO
1665
1666         HRLZI   E,(410300,,(TP))        ;BYTE POINTER TO SECOND WORD
1667                                 ;INDEXED OFF TP
1668         MOVEI   D,12.   ;# OF OCTAL DIGITS IN A WORD
1669 OCTLP2: LDB     A,E     ;GET 3 BITS
1670         IORI    A,60    ;CONVERT TO ASCII
1671         PUSHJ   P,PITYO ;PRINT IT
1672         IBP     E       ;INCREMENT POINTER TO NEXT BYTE
1673         SOJG    D,OCTLP2        ;REPEAT FOR 12. CHARS
1674
1675         MOVEI   A,"*    ;DELIMIT END OF ERROR TYPEOUT
1676         PUSHJ   P,PITYO ;REPRINT IT
1677
1678         JRST    PNEXT   ;RESTORE REGS & POP UP ONE LEVEL TO CALLER
1679
1680 POCTAL: MOVEI   A,14.   ;RETURN TO NEW LINE IF 14. SPACES NOT LEFT
1681         MOVE    B,-2(TP)                ; GET CHANNEL INTO B
1682         PUSHJ   P,RETIF
1683         JRST    PRE01   ;PRINT VALUE AS "*XXXXXXXXXXXX*"
1684
1685 \f;PRINT BINARY INTEGERS IN DECIMAL.
1686 ;
1687 PFIX:   MOVM    E,(TP)          ; GET # (MAFNITUDE)
1688         JUMPL   E,POCTAL        ; IF ABS VAL IS NEG, MUST BE SETZ
1689         PUSH    P,FLAGS
1690
1691 PFIX1:  MOVE    B,-2(TP)        ; GET CHANNEL INTO B
1692 PFIX2:  MOVE    D,UPB+6         ; IF UNPARSE, THIS IS RADIX
1693         TLNE    FLAGS,UNPRSE+FLTBIT     ;SKIPS IF NOT FROM UNPARSE OR FLATSIZE
1694         JRST    PFIXU
1695         MOVE    D,RADX(B)       ; GET OUTPUT RADIX
1696 PFIXU:  CAIG    D,1             ; DONT ALLOW FUNNY RADIX
1697         MOVEI   D,10.           ; IF IN DOUBT USE 10.
1698         PUSH    P,D
1699         MOVEI   A,1             ; START A COUNTER
1700         SKIPGE  B,(TP)          ; CHECK SIGN
1701         MOVEI   A,2             ; NEG, NEED CHAR FOR SIGN
1702
1703         IDIV    B,D             ; START COUNTING
1704         JUMPE   B,.+2
1705         AOJA    A,.-2
1706
1707         MOVE    B,-2(TP)        ; CHANNEL TO B
1708         TLNN    FLAGS,FLTBIT+BINBIT
1709         PUSHJ   P,RETIF3        ; CHECK FOR C.R.
1710         MOVE    B,-2(TP)                ; RESTORE CHANNEL
1711         MOVEI   A,"-            ; GET SIGN
1712         SKIPGE  (TP)            ; SKIP IF NOT NEEDED
1713         PUSHJ   P,PITYO
1714         MOVM    C,(TP)  ; GET MAGNITUDE OF #
1715         MOVE    B,-2(TP)        ; RESTORE CHANNEL
1716         POP     P,E             ; RESTORE RADIX
1717         PUSHJ   P,FIXTYO        ; WRITE OUT THE #
1718         MOVE    FLAGS,-1(P)
1719         SUB     P,[1,,1]        ; FLUSH P STUFF
1720         JRST    PNEXT
1721
1722 FIXTYO: IDIV    C,E
1723         PUSH    P,D             ; SAVE REMAINDER
1724         SKIPE   C
1725         PUSHJ   P,FIXTYO
1726         POP     P,A             ; START GETTING #'S BACK
1727         ADDI    A,60
1728         MOVE    B,-2(TP)                ; CHANNEL BACK
1729         JRST    PITYO
1730
1731 \f;PRINT SINGLE-PRECISION FLOATING POINT NUMBERS IN DECIMAL.
1732 ;
1733 PFLOAT: SKIPN   A,(TP)          ; SKIP IF NUMBER IS NON-ZERO
1734                                 ;       SPECIAL HACK FOR ZERO)
1735         JRST    PFLT0           ; HACK THAT ZERO
1736         MOVM    E,A             ; CHECK FOR NORMALIZED
1737         TLNN    E,400           ; NORMALIZED
1738         JRST    PUNK
1739         MOVE    E,[SETZ FLOATB] ;ADDRESS OF FLOATING POINT CONVERSION ROUTINE
1740         MOVE    D,[6,,6]        ;# WORDS TO GET FROM STACK
1741
1742 PNUMB:  HRLI    A,1(P)          ; LH(A) TO CONTAIN ADDRESS OF RETURN AREA
1743                                 ;       ON STACK
1744         HRR     A,TP            ; RH(A) TO CONTAIN ADDRESS OF DATA ITEM
1745         HLRZ    B,A             ; SAVE RETURN AREA ADDRESS IN REG B
1746         ADD     P,D             ; ADD # WORDS OF RETURN AREA TO BOTH HALVES OF
1747                                 ;       SP
1748         JUMPGE  P,PDLERR        ; PLUS OR ZERO STACK POINTER IS OVERFLOW
1749 PDLWIN: PUSHJ   P,(E)           ; CALL ROUTINE WHOSE ADDRESS IS IN REG E
1750
1751         MOVE    C,(B)           ; GET COUNT 0F # CHARS RETURNED
1752 PFLT1:  MOVE    A,B
1753         HRR     B,P             ; GET PSTACK POINTER AND PRODUCE RELATAVIZED
1754         SUB     A,B
1755         HRLS    A                       ; ADD TO AOBJN
1756         ADD     A,P             ; PRODUCE PDL POINTER
1757         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
1758         PUSH    TP,$TPDL                ; PUSH PDL POINTER
1759         PUSH    TP,A
1760         MOVE    A,C             ; MAKE SURE THAT # WILL FIT ON PRINT LINE
1761         PUSH    P,D             ; WATCH THAT MCALL
1762         PUSHJ   P,RETIF         ; START NEW LINE IF IT WON'T
1763         POP     P,D
1764         POP     TP,B            ; RESTORE B
1765         SUB     TP,[1,,1]               ; CLEAN OFF STACK
1766
1767         HRLI    B,000700        ;MAKE REG B INTO BYTE POINTER TO FIRST CHAR
1768                                 ;       LESS ONE
1769 PNUM01: ILDB    A,B             ; GET NEXT BYTE
1770         PUSH    P,B             ; SAVE B
1771         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
1772         PUSHJ   P,PITYO         ; PRINT IT
1773         POP     P,B             ; RESTORE B
1774         SOJG    C,PNUM01        ; DECREMENT CHAR COUNT: LOOP IF NON-ZERO
1775
1776         SUB     P,D     ;SUBTRACT # WORDS USED ON STACK FOR RETURN
1777         JRST    PNEXT   ;STORE REGS & POP UP ONE LEVEL TO CALLER
1778
1779
1780 PFLT0:  MOVEI   A,9.    ; WIDTH OF 0.0000000
1781         MOVEI   C,9.    ; SEE ABOVE
1782         MOVEI   D,0     ; WE'RE GONNA TEST D SOON...SO WILL DO RIGHT THING
1783         MOVEI   B,[ASCII /0.0000000/]
1784         SOJA    B,PFLT1 ; PT TO 1 BELOW CONST, THEN REJOIN CODE
1785
1786
1787
1788
1789 PDLERR: SUB     P,D             ;REST STACK POINTER
1790 REPEAT 6,PUSH   P,[0]
1791         JRST PDLWIN
1792 \f
1793 ; FLOATING POINT PRINTER STOLEN FROM DDT
1794
1795 F==E+1
1796 G==F+1
1797 H==G+1
1798 I==H+1
1799 J==I+1
1800 TEM1==I
1801
1802 FLOATB: PUSH    P,B
1803         PUSH    P,C
1804         PUSH    P,D
1805         PUSH    P,F
1806         PUSH    P,G
1807         PUSH    P,H
1808         PUSH    P,I
1809         PUSH    P,0
1810         PUSH    P,J
1811         MOVSI   0,440700        ; BUILD BYTEPNTR
1812         HLRZ    J,A             ; POINT TO BUFFER
1813         HRRI    0,1(J)
1814         ANDI    A,-1
1815         MOVE    A,(A)           ; GET NUMBER
1816         MOVE    D,A
1817         SETZM   (J)             ; Clear counter
1818         PUSHJ   P,NFLOT
1819         POP     P,J
1820         POP     P,0
1821         POP     P,I
1822         POP     P,H
1823         POP     P,G
1824         POP     P,F
1825         POP     P,D
1826         POP     P,C
1827         POP     P,B
1828         POPJ    P,
1829
1830 ; at this point we enter code abstracted from DDT.
1831 NFLOT:  JUMPG   A,TFL1
1832         JUMPE   A,FP1A
1833         MOVNS   A
1834         PUSH    P,A
1835         MOVEI   A,"-
1836         PUSHJ   P,CHRO
1837         POP     P,A
1838         TLZE    A,400000
1839         JRST    FP1A
1840
1841 TFL1:   MOVEI   B,0
1842 TFLX:   CAMGE   A,FT01
1843         JRST    FP4
1844         CAML    A,FT8
1845         AOJA    B,FP4
1846 FP1A:
1847 FP3:    SETZB   C,TEM1          ; CLEAR DIGIT CNTR, C TO RECEIVE FRACTION
1848         MULI    A,400
1849         ASHC    B,-243(A)
1850         MOVE    A,B
1851         PUSHJ   P,FP7
1852         PUSH    P,A
1853         MOVEI   A,".
1854         PUSHJ   P,CHRO
1855         POP     P,A
1856         MOVNI   A,10
1857         ADD     A,TEM1
1858         MOVE    E,C
1859 FP3A:   MOVE    D,E
1860         MULI    D,12
1861         PUSHJ   P,FP7B
1862         SKIPE   E
1863         AOJL    A,FP3A
1864         POPJ    P,              ; ONE return from OFLT here
1865
1866 FP4:    MOVNI   C,6
1867         MOVEI   F,0
1868 FP4A:   ADDI    F,1(F)
1869         XCT     FCP(B)
1870         SOSA    F
1871         FMPR    A,@FXP+1(B)
1872         AOJN    C,FP4A
1873         PUSH    P,EXPSGN(B)
1874         PUSHJ   P,FP3
1875         PUSH    P,A
1876         MOVEI   A,"E
1877         PUSHJ   P,CHRO
1878         POP     P,A
1879         POP     P,D
1880         PUSHJ   P,FDIGIT
1881         MOVE    A,F
1882
1883 FP7:    SKIPE   A       ; AVOID AOSING TEM1, NOT SIGNIFICANT DIGIT
1884         AOS     TEM1
1885         IDIVI   A,12
1886         PUSH    P,B
1887         JUMPE   A,FP7A1
1888         PUSHJ   P,FP7
1889
1890 FP7A1:  POP     P,D
1891 FP7B:   ADDI    D,"0
1892
1893 ; type digit
1894 FDIGIT: PUSH    P,A
1895         MOVE    A,D
1896         PUSHJ   P,CHRO
1897         POP     P,A
1898         POPJ    P,
1899
1900 CHRO:   AOS     (J)     ; COUNT CHAR
1901         IDPB    A,0     ; STUFF CHAR
1902         POPJ    P,
1903
1904 ; constants
1905         1.0^32.
1906         1.0^16.
1907 FT8:    1.0^8
1908         1.0^4
1909         1.0^2
1910         1.0^1
1911 FT:     1.0^0
1912         1.0^-32.
1913         1.0^-16.
1914         1.0^-8
1915         1.0^-4
1916         1.0^-2
1917 FT01:   1.0^-1
1918 FT0=FT01+1
1919
1920 ; instructions
1921 FCP:    CAMLE   A, FT0(C)
1922         CAMGE   A, FT(C)
1923         0, FT0(C)
1924 FXP:    SETZ FT0(C)
1925         SETZ FT(C)
1926         SETZ FT0(C)
1927 EXPSGN: "-
1928         "+
1929
1930 \f
1931 ;PRINT SHORT (ONE WORD) CHARACTER STRINGS
1932
1933 PCHRS:  MOVEI   A,3     ;MAX # CHARS PLUS 2 (LESS ESCAPES)
1934         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
1935         TLNE    FLAGS,NOQBIT    ;SKIP IF QUOTES WILL BE USED
1936         MOVEI   A,1     ;ELSE, JUST ONE CHARACTER POSSIBLE
1937         PUSHJ   P,RETIF ;NEW LINE IF INSUFFICIENT SPACE
1938         TLNE    FLAGS,NOQBIT    ;DON'T QUOTE IF IN PRINC MODE
1939         JRST    PCASIS
1940         MOVEI   A,"!    ;TYPE A EXCL
1941         PUSHJ   P,PITYO
1942         MOVEI   A,"\            ;AND A BACK SLASH
1943         PUSHJ   P,PITYO
1944
1945 PCASIS: MOVE    A,(TP)          ;GET NEXT BYTE FROM WORD
1946         TLNE    FLAGS,NOQBIT    ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
1947         JRST    PCPRNT          ;IF BIT IS ON, PRINT WITHOUT ESCAPING
1948         CAIE    A,ESCHAR        ;SKIP IF NOT THE ESCAPE CHARACTER
1949         JRST    PCPRNT          ;ESCAPE THE ESCAPE CHARACTER
1950
1951 ESCPRT: MOVEI   A,ESCHAR        ;TYPE THE ESCAPE CHARACTER
1952         PUSHJ   P,PITYO
1953 PCPRNT: MOVE    A,(TP)          ;GET THE CHARACTER AGAIN
1954         TLNE    FLAGS,NOQBIT    ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
1955         TLO     FLAGS,CNTLPC    ;SWITCH ON ^P MODE TEMPORARY
1956         PUSHJ   P,PITYO         ;PRINT IT
1957         TLZ     FLAGS,CNTLPC    ;SWITCH OFF ^P MODE
1958         JRST    PNEXT
1959
1960
1961 \f;PRINT DEFERED (INVISIBLE) ITEMS. (PRINTED AS THE THING POINTED TO)
1962 ;
1963 PDEFER: MOVE    A,(B)   ;GET FIRST WORD OF ITEM
1964         MOVE    B,1(B)  ;GET SECOND
1965         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
1966         PUSH    TP,-3(TP)
1967         PUSHJ   P,IPRINT        ;PRINT IT
1968         SUB     TP,[2,,2]       ; POP OFF CHANNEL
1969         JRST    PNEXT   ;GO EXIT
1970
1971
1972 ; Print an ATOM.  TRAILERS are added if the atom is not in the current
1973 ; lexical path.  Also escaping of charactets is performed to allow READ
1974 ; to win.
1975
1976 PATOM:  PUSH    P,[440700,,D]   ; PUSH BYE POINTER TO FINAL STRING
1977         SETZB   D,E             ; SET CHARCOUNT AD DESTINATION TO 0
1978         HLLZS   -1(TP)          ; RH OF TATOM,, WILL COUNT ATOMS IN PATH
1979
1980 PATOM0: PUSH    TP,$TPDL        ; SAVE CURRENT STAKC FOR \ LOGIC
1981         PUSH    TP,P
1982         LDB     A,[301400,,(P)] ; GET BYTE PTR POSITION
1983         DPB     A,[301400,,E]   ; SAVE IN E
1984         MOVE    C,-2(TP)        ; GET ATOM POINTER
1985         ADD     C,[3,,3]        ; POINT TO PNAME
1986         JUMPGE  C,BADPNM        ; NO PNAME, ERROR
1987         HLRE    A,C             ; -# WORDS TO A
1988         PUSH    P,A             ; PUSH THAT FOR "AOSE"
1989         MOVEI   A,177           ; PUT RUBOUT WHERE \ MIGHT GO
1990         JSP     B,DOIDPB
1991         HRLI    C,440700        ; BUILD BYTE POINTER
1992         ILDB    A,C             ; GET FIRST BYTE
1993         JUMPE   A,BADPNM        ; NULL PNAME, ERROR
1994         SKIPA
1995 PATOM1: ILDB    A,C             ; GET A CHAR
1996         JUMPE   A,PATDON        ; END OF PNAME?
1997         TLNN    C,760000        ; SKIP IF NOT WORD BOUNDARY
1998         AOS     (P)             ; COUNT WORD
1999         JRST    PENTCH          ; ENTER THE CHAR INTO OUTPUT
2000
2001 PATDON: LDB     A,[220600,,E]   ; GET "STATE"
2002         LDB     A,STABYT+NONSPC+1       ; SIMULATE "END" CHARACTER
2003         DPB     A,[220600,,E]   ; AND STORE
2004         MOVE    B,E             ; SETUP BYTE POINTER TO 1ST CHAR
2005         TLZ     B,77
2006         HRR     B,(TP)  ; POINT
2007         SUB     TP,[2,,2]       ; FLUSH SAVED PDL
2008         MOVE    C,-1(P)         ; GET BYE POINTER
2009         SUB     P,[2,,2]        ; FLUSH
2010         PUSH    P,D
2011         MOVEI   A,0
2012         IDPB    A,B
2013         AOS     -1(TP)          ; COUNT ATOMS
2014         TLNE    FLAGS,NOQBIT    ; SKIP IF NOT "PRINC"
2015         JRST    NOLEX4          ; NEEDS NO LEXICAL TRAILERS
2016         MOVEI   A,"\            ; GET QUOTER
2017         TLNN    E,2             ; SKIP IF NEEDED
2018         JRST    PATDO1
2019         SOS     -1(TP)          ; DONT COUNT BECAUSE OF SLASH
2020         DPB     A,B             ; CLOBBER
2021 PATDO1: MOVEI   E,(E)           ; CLEAR LH(E)
2022         PUSH    P,C             ; SAVE BYTER
2023         PUSH    P,E             ; ALSO CHAR COUNT
2024
2025         MOVE    B,IMQUOTE OBLIST
2026         PUSH    P,FLAGS
2027         PUSHJ   P,IDVAL         ; GET LOCAL/GLOBAL VALUE
2028         POP     P,FLAGS         ; AND RESTORES FLAGS
2029         MOVE    C,(TP)          ; GET ATOM BACK
2030         HRRZ    C,2(C)          ; GET ITS OBLIST
2031         SKIPN   C
2032         AOJA    A,NOOBL1        ; NONE, USE FALSE
2033         CAMG    C,VECBOT        ; JUMP IF REAL OBLIST
2034         MOVE    C,(C)
2035         HRROS   C
2036         CAME    A,$TLIST        ; SKIP IF  A LIST
2037         CAMN    A,$TOBLS        ; SKIP IF UNREASONABLE VALUE
2038         JRST    CHOBL           ; WINS, NOW LOCATE IT
2039
2040 CHROOT: CAME    C,ROOT+1        ; IS THIS ROOT?
2041         JRST    FNDOBL          ; MUST FIND THE PATH NAME
2042         POP     P,E             ; RESTORE CHAR COUNT
2043         MOVE    D,(P)           ; AND PARTIAL WORD
2044         EXCH    D,-1(P)         ; STORE BYTE POINTER AND GET PARTIAL WORD
2045         MOVEI   A,"!            ; PUT OUT MAGIC
2046         JSP     B,DOIDPB        ; INTO BUFFER
2047         MOVEI   A,"-
2048         JSP     B,DOIDPB
2049         MOVEI   A,40
2050         JSP     B,DOIDPB
2051
2052 NOLEX0: SUB     P,[2,,2]        ; REMOVE COUNTER AND BYTE POINTER
2053         PUSH    P,D             ; PUSH NEXT WORD IF ANY
2054         JRST    NOLEX4
2055
2056 NOLEX:  MOVE    E,(P)           ; GET COUNT
2057         SUB     P,[2,,2]
2058 NOLEX4: MOVEI   E,(E)           ; CLOBBER LH(E)
2059         MOVE    A,E             ; COUNT TO A
2060         SKIPN   (P)             ; FLUSH 0 WORD
2061         SUB     P,[1,,1]
2062         HRRZ    C,-1(TP)        ; GET # OF ATOMS
2063         SUBI    A,(C)           ; FIX COUNT
2064         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2065         PUSHJ   P,RETIF         ; MAY NEED C.R.
2066         MOVEI   C,-1(E)         ; COMPUTE WORDS-1
2067         IDIVI   C,5             ; WORDS-1 TO C
2068         HRLI    C,(C)
2069         MOVE    D,P
2070         SUB     D,C             ; POINTS TO 1ST WORD OF CHARS
2071         MOVSI   C,440700+D      ; BYTEPOINTER TO STRING
2072         PUSH    TP,$TPDL                ; SAVE FROM GC
2073         PUSH    TP,D
2074
2075 PATOUT: ILDB    A,C             ; READ A CHAR
2076         SKIPE   A               ; IGNORE NULS
2077         PUSHJ   P,PITYO         ; PRINT IT
2078         MOVE    D,(TP)          ; RESTORE POINTER
2079         SOJG    E,PATOUT
2080
2081 NOLEXD: SUB     TP,[2,,2]       ; FLUSH TP JUNK
2082         MOVE    P,D             ; RESTORE P
2083         SUB     P,[1,,1]
2084         JRST    PNEXT
2085
2086
2087 PENTCH: TLNE    FLAGS,NOQBIT    ; "PRINC"?
2088         JRST    PENTC1          ; YES, AVOID SLASHING
2089         IDIVI   A,CHRWD ; GET CHARS TYPE
2090         LDB     B,BYTPNT(B)
2091         CAILE   B,NONSPC        ; SKIP IF NOT SPECIAL
2092         JRST    PENTC2          ; SLASH IMMEDIATE
2093         LDB     A,[220600,,E]   ; GET "STATE"
2094         LDB     A,STABYT-1(B)   ; GET NEW STATE
2095         DPB     A,[220600,,E]   ; AND SAVE IT
2096 PENTC3: LDB     A,C             ; RESTORE CHARACTER
2097 PENTC1: JSP     B,DOIDPB
2098         SKIPGE  (P)             ; SKIP IF DONE
2099         JRST    PATOM1          ; CONTINUE
2100         JRST    PATDON
2101
2102 PENTC2: MOVEI   A,"\            ; GET CHAR QUOTER
2103         JSP     B,DOIDPB        ; NEEDED, DO IT
2104         MOVEI   A,4             ; PATCH FOR ATOMS ALREADY BACKSLASHED
2105         JRST    PENTC3-1
2106
2107 ; ROUTINE TO PUT ONE CHAR ON STACK BUFFER
2108
2109 DOIDPB: IDPB    A,-1(P)         ; DEPOSIT
2110         TRNN    D,377           ; SKIP IF D FULL
2111         AOJA    E,(B)
2112         PUSH    P,(P)           ; MOVE TOP OF STACK UP
2113         MOVEM   D,-2(P)         ; SAVE WORDS
2114         MOVE    D,[440700,,D]
2115         MOVEM   D,-1(P)
2116         MOVEI   D,0
2117         AOJA    E,(B)
2118
2119 ; CHECK FOR UNIQUENESS LOOKING INTO PATH
2120
2121 CHOBL:  CAME    A,$TOBLS        ; SINGLE OBLIST?
2122         JRST    LSTOBL          ; NO, AL LIST THEREOF
2123         CAME    B,C             ; THE RIGTH ONE?
2124         JRST    CHROOT          ; NO, CHECK ROOT
2125         JRST    NOLEX           ; WINNER, NO TRAILERS!
2126
2127 LSTOBL: PUSH    TP,A            ; SCAN A LIST OF OBLISTS
2128         PUSH    TP,B
2129         PUSH    TP,A
2130         PUSH    TP,B
2131         PUSH    TP,$TOBLS
2132         PUSH    TP,C
2133
2134 NXTOB2: INTGO                   ; LIST LOOP, PREVENT LOSSAGE
2135         SKIPN   C,-2(TP)                ; SKIP IF NOT DONE
2136         JRST    CHROO1          ; EMPTY, CHECK ROOT
2137         MOVE    B,1(C)          ; GET ONE
2138         CAME    B,(TP)          ; WINNER?
2139         JRST    NXTOBL          ; NO KEEP LOOKING
2140         CAMN    C,-4(TP)        ; SKIP IF NOT FIRST ON  LIST
2141         JRST    NOLEX1
2142         MOVE    A,-6(TP)        ; GET ATOM BACK
2143         MOVEI   D,0
2144         ADD     A,[3,,3]        ; POINT TO PNAME
2145         PUSH    P,0             ; SAVE FROM RLOOKU
2146         PUSH    P,(A)
2147         ADDI    D,5
2148         AOBJN   A,.-2           ; PUSH THE PNAME
2149         PUSH    P,D             ; AND CHAR COUNT
2150         MOVSI   A,TLIST         ; TELL RLOOKU WE WIN
2151         MOVE    B,-4(TP)        ; GET BACK OBLIST LIST
2152         SUB     TP,[6,,6]       ; FLUSH CRAP
2153         PUSHJ   P,RLOOKU        ; FIND IT
2154         POP     P,0
2155         CAMN    B,(TP)          ; SKIP IF NON UNIQUE
2156         JRST    NOLEX           ; UNIQUE , NO TRAILER!!
2157         JRST    CHROO2          ; CHECK ROOT
2158
2159 NXTOBL: HRRZ    B,@-2(TP)       ; STEP THE LIST
2160         MOVEM   B,-2(TP)
2161         JRST    NXTOB2
2162
2163
2164 FNDOBL: MOVE    C,(TP)          ; GET ATOM
2165         MOVSI   A,TOBLS
2166         HRRZ    B,2(C)
2167         CAMG    B,VECBOT
2168         MOVE    B,(B)
2169         HRLI    B,-1
2170         MOVSI   C,TATOM
2171         MOVE    D,IMQUOTE OBLIST
2172         PUSH    P,0
2173         PUSHJ   P,IGET
2174         POP     P,0
2175 NOOBL1: POP     P,E             ; RESTORE CHAR COUNT
2176         MOVE    D,(P)           ; GET PARTIAL WORD
2177         EXCH    D,-1(P)         ; AND BYTE POINTER
2178         CAME    A,$TATOM        ; IF NOT ATOM, USE FALSE
2179         JRST    NOOBL
2180         MOVEM   B,(TP)          ; STORE IN ATOM SLOT
2181         MOVEI   A,"!
2182         JSP     B,DOIDPB        ; WRITE IT OUT
2183         MOVEI   A,"-
2184         JSP     B,DOIDPB
2185         SUB     P,[1,,1]
2186         JRST    PATOM0          ; AND LOOP
2187
2188 NOOBL:  MOVE    C,[440700,,[ASCIZ /!-#FALSE ()/]]
2189         ILDB    A,C
2190         JUMPE   A,NOLEX0
2191         JSP     B,DOIDPB
2192         JRST    .-3
2193
2194
2195 NOLEX1: SUB     TP,[6,,6]       ; FLUSH STUFF
2196         JRST    NOLEX
2197
2198 CHROO1: SUB     TP,[6,,6]
2199 CHROO2: MOVE    C,(TP)          ; GET ATOM
2200         HRRZ    C,2(C)          ; AND ITS OBLIST
2201         CAMG    C,VECBOT
2202         MOVE    C,(C)
2203         HRROS   C
2204         JRST    CHROOT
2205 BADPNM: ERRUUO  EQUOTE BAD-PNAME
2206
2207
2208 \f; STATE TABLES FOR \ OF FIRST CHAR
2209 ;       Each word is a state and each 4 bit byte tells where to go based on the input
2210 ; type.  The types are defined in READER >.  The input type selects a byte pointer
2211 ; into the table which is indexed by the current state.
2212
2213 RADIX 16.
2214
2215 STATS:  431192440               ; INITIAL STATE (0)
2216         434444444               ; HERE ON INIT +- (1)
2217         222222242               ; HERE ON INIT . (2)
2218         434445642               ; HERE ON INIT DIGIT (3)
2219         444444444               ; HERE IF NO \ NEEDE (4)
2220         454444642               ; HERE ON DDDD. (5)
2221         487744444               ; HERE ON E (6)
2222         484444444               ; HERE ON E+- (7)
2223         484444442               ; HERE ON E+-DDD (8)
2224         494444444+<1_28.>       ; HERE ON * (HACK IS TO GET A 10 IN THERE) (9)
2225         494494444+<1_28.>+<2_16.>       ; HERE ON *DDDDD (10)
2226         444444442
2227
2228 RADIX 8.
2229
2230 STABYT: 400400,,STATS(A)        ; LETTERS
2231         340400,,STATS(A)        ; NUMBERS
2232         300400,,STATS(A)        ; PLUS SIGN +
2233         240400,,STATS(A)        ; MINUS SIGN -
2234         200400,,STATS(A)        ; asterick *
2235         140400,,STATS(A)        ; PERIOD .
2236         100400,,STATS(A)        ; LETTER E
2237         040400,,STATS(A)        ; extra
2238         000400,,STATS(A)        ; HERE ON RAP UP
2239
2240 \f;PRINT LONG CHARACTER STRINGS.
2241 ;
2242 PCHSTR: MOVE    B,(TP)
2243         TLZ     FLAGS,ATMBIT    ;WE ARE NOT USING ATOM-NAME TYPE ESCAPING
2244         MOVE    D,[AOS E]       ;GET INSTRUCTION TO COUNT CHARACTERS
2245         SETZM   E               ;ZERO COUNT
2246         PUSH    TP,-3(TP)
2247         PUSH    TP,-3(TP)
2248         PUSH    TP,-3(TP)
2249         PUSH    TP,-3(TP)       ;GIVE PCHRST SOME GOODIES TO PLAY WITH
2250         PUSHJ   P,PCHRST        ;GO THROUGH STRING, ESCAPING, ETC. AND COUNTING
2251         SUB     TP,[4,,4]       ;FLUSH MUNGED GOODIES
2252         MOVE    A,E             ;PUT COUNT RETURNED IN REG A
2253         TLNN    FLAGS,NOQBIT    ;SKIP (NO QUOTES) IF IN PRINC (BIT ON)
2254          ADDI   A,2             ;PLUS TWO FOR QUOTES
2255         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2256         PUSHJ   P,RETIF         ;START NEW LINE IF NO SPACE
2257         TLNE    FLAGS,NOQBIT    ;SKIP (PRINT ") IF BIT IS OFF (NOT PRINC)
2258          JRST   PCHS01          ;OTHERWISE, DON'T QUOTE
2259         MOVEI   A,""            ;PRINT A DOUBLE QUOTE
2260         MOVE    B,-2(TP)
2261         PUSHJ   P,PITYO
2262
2263 PCHS01: MOVE    D,[PUSHJ P,PITYO] ;OUTPUT INSTRUCTION
2264         PUSHJ   P,PCHRST        ;TYPE STRING
2265
2266         TLNE    FLAGS,NOQBIT    ;AGAIN, SKIP IF DOUBLE-QUOTING TO BE DONE
2267          JRST   PNEXT           ;RESTORE REGS & POP UP ONE LEVEL TO CALLER
2268         MOVEI   A,""            ;PRINT A DOUBLE QUOTE
2269         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2270         PUSHJ   P,PITYO
2271         JRST    PNEXT
2272
2273
2274 ;INTERNAL ROUTINE USED TO COUNT OR OUTPUT CHARACTER STRINGS.
2275 ;THE APPROPRIATE ESCAPING CONVENTIONS ARE USED AS DETERMINED BY THE FLAG BITS.
2276 PCHRST: PUSH    P,A     ;SAVE REGS
2277         PUSH    P,B
2278         PUSH    P,C
2279         PUSH    P,D
2280
2281 PCHR02: INTGO                   ; IN CASE VERY LONG STRING
2282         HRRZ    C,-1(TP)        ;GET COUNT
2283         SOJL    C,PCSOUT        ; DONE?
2284         HRRM    C,-1(TP)
2285         ILDB    A,(TP)          ; GET CHAR
2286
2287         TLNE    FLAGS,NOQBIT    ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
2288         JRST    PCSPRT  ;IF BIT IS ON, PRINT WITHOUT ESCAPING
2289         CAIN    A,ESCHAR        ;SKIP IF NOT THE ESCAPE CHARACTER
2290         JRST    ESCPRN  ;ESCAPE THE ESCAPE CHARACTER
2291         CAIN    A,""    ;SKIP IF NOT A DOUBLE QUOTE
2292         JRST    ESCPRN  ;OTHERWISE, ESCAPE THE """
2293         IDIVI   A,CHRWD ;CODE HERE FINDS CHARACTER TYPE
2294         LDB     B,BYTPNT(B)     ; "
2295         CAIG    B,NONSPC        ;SKIP IF NOT A NUMBER/LETTER
2296         JRST    PCSPRT  ;OTHERWISE, PRINT IT
2297         TLNN    FLAGS,ATMBIT    ;SKIP IF PRINTING AN ATOM-NAME (UNQUOTED)
2298         JRST    PCSPRT  ;OTHERWISE, NO OTHER CHARS TO ESCAPE
2299
2300 ESCPRN: MOVEI   A,ESCHAR        ;TYPE THE ESCAPE CHARACTER
2301         PUSH    P,B             ; SAVE B
2302         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2303         XCT     (P)-1
2304         POP     P,B             ; RESTORE B
2305
2306 PCSPRT: LDB     A,(TP)  ;GET THE CHARACTER AGAIN
2307         PUSH    P,B             ; SAVE B
2308         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2309         TLNE    FLAGS,NOQBIT    ; SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
2310         TLO     FLAGS,CNTLPC    ; SWITCH ON TEMPORARY ^P MODE
2311         XCT     (P)-1           ;PRINT IT
2312         TLZ     FLAGS,CNTLPC    ; SWITCH OFF ^P MODE
2313         POP     P,B             ; RESTORE B
2314         JRST    PCHR02          ;LOOP THROUGH STRING
2315
2316 PCSOUT: POP     P,D
2317         POP     P,C     ;RESTORE REGS & RETURN
2318         POP     P,B
2319         POP     P,A
2320         POPJ    P,
2321
2322
2323 \f
2324 ; PRINT AN ARBITRARY BYTE STRING
2325
2326 PBYTE:  PUSH    TP,-3(TP)
2327         PUSH    TP,-3(TP)
2328         MOVEI   A,"#
2329         MOVE    B,(TP)
2330         PUSHJ   P,PRETIF
2331         LDB     B,[300600,,-2(TP)]
2332         MOVSI   A,TFIX
2333         PUSHJ   P,IPRINT
2334         MOVE    B,(TP)
2335         PUSHJ   P,SPACEQ
2336         MOVEI   A,"{
2337         MOVE    B,(TP)
2338         PUSHJ   P,PRETIF
2339         HRRZ    A,-3(TP)                ; CHAR COUNT
2340         JUMPE   A,CLSBYT
2341
2342 BYTLP:  SOS     -3(TP)
2343         ILDB    B,-2(TP)                ; GET A BYTE
2344         MOVSI   A,TFIX
2345         PUSHJ   P,IPRINT
2346         HRRZ    A,-3(TP)
2347         JUMPE   A,CLSBYT
2348         MOVE    B,(TP)
2349         PUSHJ   P,SPACEQ
2350         JRST    BYTLP
2351
2352 CLSBYT: MOVEI   A,"}
2353         MOVE    B,(TP)
2354         PUSHJ   P,PRETIF
2355         SUB     TP,[2,,2]
2356         JRST    PNEXT
2357
2358
2359 ;PRINT AN ARGUMENT LIST
2360 ;CHECK FOR TIME ERRORS
2361
2362 PARGS:  MOVEI   B,-1(TP)        ;POINT TO ARGS POINTER
2363         PUSHJ   P,CHARGS        ;AND CHECK THEM
2364         JRST    PVEC            ; CHEAT TEMPORARILY
2365
2366
2367
2368 ;PRINT A FRAME
2369 PFRAME: MOVEI   B,-1(TP)        ;POINT TO FRAME POINTER
2370         PUSHJ   P,CHFRM
2371         HRRZ    B,(TP)          ;POINT TO FRAME ITSELF
2372         HRRZ    B,FSAV(B)       ;GET POINTER TO SUBROUTINE
2373         CAIL    B,HIBOT
2374         SKIPA   B,@-1(B)        ; SUBRS AND FSUBRS
2375         MOVE    B,3(B)          ; FOR RSUBRS
2376         MOVSI   A,TATOM
2377         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
2378         PUSH    TP,-3(TP)
2379         PUSHJ   P,IPRINT        ;PRINT FUNCTION NAME
2380         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
2381         JRST    PNEXT
2382
2383 PPVP:   MOVE    B,(TP)          ; PROCESS TO B
2384         MOVSI   A,TFIX
2385         JUMPE   B,.+3
2386         MOVE    A,PROCID(B)
2387         MOVE    B,PROCID+1(B)   ;GET ID
2388         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
2389         PUSH    TP,-3(TP)
2390         PUSHJ   P,IPRINT
2391         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
2392         JRST    PNEXT
2393
2394 ; HERE TO PRINT LOCATIVES
2395
2396 LOCPT1: HRRZ    A,-1(TP)
2397         JUMPN   A,PUNK
2398 LOCPT:  MOVEI   B,-1(TP)        ; VALIDITY CHECK
2399         PUSHJ   P,CHLOCI
2400         HRRZ    A,-1(TP)
2401         JUMPE   A,GLOCPT
2402         MOVE    B,(TP)
2403         MOVE    A,(B)
2404         MOVE    B,1(B)
2405         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
2406         PUSH    TP,-3(TP)
2407         PUSHJ   P,IPRINT
2408         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
2409         JRST    PNEXT
2410
2411 GLOCPT: MOVEI   A,2
2412         MOVE    B,-2(TP)                ; GET CHANNEL
2413         PUSHJ   P,RETIF
2414         MOVEI   A,"%
2415         PUSHJ   P,PITYO
2416         MOVEI   A,"<
2417         PUSHJ   P,PITYO
2418         MOVSI   A,TATOM
2419         MOVE    B,MQUOTE GLOC
2420         PUSH    TP,-3(TP)
2421         PUSH    TP,-3(TP)
2422         PUSHJ   P,IPRINT
2423         SUB     TP,[2,,2]
2424         MOVE    B,-2(TP)                ; MOVE IN CHANNEL
2425         PUSHJ   P,SPACEQ
2426         MOVE    B,(TP)
2427         MOVSI   A,TATOM
2428         MOVE    B,-1(B)
2429         PUSH    TP,-3(TP)
2430         PUSH    TP,-3(TP)
2431         PUSHJ   P,IPRINT
2432         SUB     TP,[2,,2]
2433         MOVE    B,-2(TP)                ; MOVE IN CHANNEL
2434         PUSHJ   P,SPACEQ
2435         MOVSI   A,TATOM
2436         MOVE    B,IMQUOTE T
2437         PUSH    TP,-3(TP)
2438         PUSH    TP,-3(TP)
2439         PUSHJ   P,IPRINT
2440         SUB     TP,[2,,2]
2441         MOVE    B,-2(TP)                ; MOVE IN CHANNEL
2442         MOVEI   A,">
2443         PUSHJ   P,PRETIF
2444         JRST    PNEXT
2445
2446 LOCRPT: MOVEI   A,2
2447         MOVE    B,-2(TP)                ; GET CHANNEL
2448         PUSHJ   P,RETIF
2449         MOVEI   A,"%
2450         PUSHJ   P,PITYO
2451         MOVEI   A,"<
2452         PUSHJ   P,PITYO
2453         MOVSI   A,TATOM
2454         MOVE    B,MQUOTE RGLOC
2455         PUSH    TP,-3(TP)
2456         PUSH    TP,-3(TP)
2457         PUSHJ   P,IPRINT
2458         SUB     TP,[2,,2]
2459         MOVE    B,-2(TP)                ; MOVE IN CHANNEL
2460         PUSHJ   P,SPACEQ
2461         MOVE    B,(TP)
2462         MOVSI   A,TATOM
2463         ADD     B,GLOTOP+1              ; GET TO REAL ATOM
2464         MOVE    B,-1(B)
2465         PUSH    TP,-3(TP)
2466         PUSH    TP,-3(TP)
2467         PUSHJ   P,IPRINT
2468         SUB     TP,[2,,2]
2469         MOVE    B,-2(TP)                ; MOVE IN CHANNEL
2470         PUSHJ   P,SPACEQ
2471         MOVSI   A,TATOM
2472         MOVE    B,IMQUOTE T
2473         PUSH    TP,-3(TP)
2474         PUSH    TP,-3(TP)
2475         PUSHJ   P,IPRINT
2476         SUB     TP,[2,,2]
2477         MOVE    B,-2(TP)                ; MOVE IN CHANNEL
2478         MOVEI   A,">
2479         PUSHJ   P,PRETIF
2480         JRST    PNEXT
2481
2482 \f;PRINT UNIFORM VECTORS.
2483 ;
2484 PUVEC:  MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2485         MOVEI   A,2             ; ROOM FOR ! AND SQ BRACK?
2486         PUSHJ   P,RETIF
2487         MOVEI   A,"!    ;TYPE AN ! AND OPEN SQUARE BRACKET
2488         PUSHJ   P,PITYO
2489         MOVEI   A,"[
2490         PUSHJ   P,PITYO
2491
2492         MOVE    C,(TP)  ;GET AOBJN POINTER TO VECTOR
2493         TLNN    C,777777        ;SKIP ONLY IF COUNT IS NOT ZERO
2494         JRST    NULVEC  ;ELSE, VECTOR IS EMPTY
2495
2496         HLRE    A,C     ;GET NEG COUNT
2497         MOVEI   D,(C)   ;COPY POINTER
2498         SUB     D,A     ;POINT TO DOPE WORD
2499         HLLZ    A,(D)   ;GET TYPE
2500         PUSH    P,A     ;AND SAVE IT
2501
2502 PUVE02: MOVE    A,(P)   ;PUT TYPE CODE IN REG A
2503         MOVE    B,(C)   ;PUT DATUM INTO REG B
2504         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
2505         PUSH    TP,-3(TP)
2506         PUSHJ   P,IPRINT        ;TYPE IT
2507         SUB     TP,[2,,2]       ; POP CHANNEL OF STACK
2508         MOVE    C,(TP)  ;GET AOBJN POINTER
2509         AOBJP   C,NULVE1        ;JUMP IF COUNT IS ZERO
2510         MOVEM   C,(TP)  ;PUT POINTER BACK ONTO STACK
2511
2512         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2513         PUSHJ   P,SPACEQ
2514         MOVE    C,(TP)
2515         JRST    PUVE02  ;LOOP THROUGH VECTOR
2516
2517 NULVE1: SUB     P,[1,,1]        ;REMOVE STACK CRAP
2518 NULVEC: MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2519         MOVEI   A,"!    ;TYPE CLOSE BRACKET
2520         PUSHJ   P,PRETIF
2521         MOVEI   A,"]
2522         PUSHJ   P,PRETIF
2523         JRST    PNEXT
2524
2525 \f;PRINT A GENERALIZED VECTOR
2526 ;
2527 PVEC:   MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2528         PUSHJ   P,RETIF1        ;NEW LINE IF NO ROOM FOR [
2529         MOVEI   A,"[            ;PRINT A LEFT-BRACKET
2530         PUSHJ   P,PITYO
2531
2532         MOVE    C,(TP)          ;GET AOBJN POINTER TO VECTOR
2533         TLNN    C,777777        ;SKIP IF POINTER-COUNT IS NON-ZERO
2534         JRST    PVCEND          ;ELSE, FINISHED WITH VECTOR
2535 PVCR01: MOVE    A,(C)           ;PUT FIRST WORD OF NEXT ELEMENT INTO REG A
2536         MOVE    B,1(C)          ;SECOND WORD OF LIST INTO REG B
2537         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
2538         PUSH    TP,-3(TP)
2539         PUSHJ   P,IPRINT        ;PRINT THAT ELEMENT
2540         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
2541
2542         MOVE    C,(TP)          ;GET AOBJN POINTER FROM TP-STACK
2543         AOBJP   C,PVCEND        ;POSITIVE HERE SERIOUS ERROR! (THOUGH NOT PDL)
2544         AOBJN   C,.+2           ;SKIP AND CONTINUE LOOP IF COUNT NOT ZERO
2545         JRST    PVCEND          ;ELSE, FINISHED WITH VECTOR
2546         MOVEM   C,(TP)          ;PUT INCREMENTED POINTER BACK ON TP-STACK
2547
2548         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2549         PUSHJ   P,SPACEQ
2550         MOVE    C,(TP)          ; RESTORE REGISTER C
2551         JRST    PVCR01          ;CONTINUE LOOPING THROUGH OBJECTS ON VECTOR
2552
2553 PVCEND: MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2554         PUSHJ   P,RETIF1        ;NEW LINE IF NO ROOM FOR ]
2555         MOVEI   A,"]            ; PRINT A RIGHT-BRACKET
2556         PUSHJ   P,PITYO
2557         JRST    PNEXT
2558
2559 \f;PRINT A LIST.
2560 ;
2561 PLIST:  MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2562         PUSHJ   P,RETIF1        ;NEW LINE IF NO SPACE LEFT FOR "("
2563         MOVEI   A,"(            ;TYPE AN OPEN PAREN
2564         PUSHJ   P,PITYO
2565         PUSHJ   P,LSTPRT        ;PRINT THE INSIDES
2566         MOVE    B,-2(TP)                ; RESTORE CHANNEL TO B
2567         PUSHJ   P,RETIF1        ;NEW LINE IF NO ROOM FOR THE CLOSE PAREN
2568         MOVEI   A,")    ;TYPE A CLOSE PAREN
2569         PUSHJ   P,PITYO
2570         JRST    PNEXT
2571
2572 PSEG:   TLOA    FLAGS,SEGBIT    ;PRINT A SEGMENT (& SKIP)
2573
2574 PFORM:  TLZ     FLAGS,SEGBIT    ;PRINT AN ELEMENT
2575
2576 PLMNT3: MOVE    C,(TP)
2577         JUMPE   C,PLMNT1        ;IF THE CALL IS EMPTY GO AWAY
2578         MOVE    B,1(C)
2579         MOVEI   D,0
2580         CAMN    B,IMQUOTE LVAL
2581         MOVEI   D,".
2582         CAMN    B,IMQUOTE GVAL
2583         MOVEI   D,",
2584         CAMN    B,IMQUOTE QUOTE
2585         MOVEI   D,"'
2586         JUMPE   D,PLMNT1                ;NEITHER, LEAVE
2587
2588 ;ITS A SPECIAL HACK
2589         HRRZ    C,(C)
2590         JUMPE   C,PLMNT1        ;NIL BODY?
2591
2592 ;ITS VALUE OF AN ATOM
2593         HLLZ    A,(C)
2594         MOVE    B,1(C)
2595         HRRZ    C,(C)
2596         JUMPN   C,PLMNT1        ;IF TERE ARE EXTRA ARGS GO AWAY
2597
2598         PUSH    P,D             ;PUSH THE CHAR
2599         PUSH    TP,A
2600         PUSH    TP,B
2601         TLNN    FLAGS,SEGBIT    ;SKIP (CONTINUE) IF THIS IS A SEGMENT
2602         JRST    PLMNT4  ;ELSE DON'T PRINT THE "."
2603
2604 ;ITS A SEGMENT CALL
2605         MOVE    B,-4(TP)        ; GET CHANNEL INTO B
2606         MOVEI   A,2             ; ROOM FOR ! AND . OR ,
2607         PUSHJ   P,RETIF
2608         MOVEI   A,"!
2609         PUSHJ   P,PITYO
2610
2611 PLMNT4: MOVE    B,-4(TP)                ; GET CHANNEL INTO B
2612         PUSHJ   P,RETIF1
2613         POP     P,A             ;RESTORE CHAR
2614         PUSHJ   P,PITYO
2615         POP     TP,B
2616         POP     TP,A
2617         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
2618         PUSH    TP,-3(TP)
2619         PUSHJ   P,IPRINT
2620         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
2621         JRST    PNEXT
2622
2623
2624 PLMNT1: TLNN    FLAGS,SEGBIT    ;SKIP IF THIS IS A SEGMENT
2625         JRST    PLMNT5  ;ELSE DON'T TYPE THE "!"
2626
2627 ;ITS A SEGMENT CALL
2628         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2629         MOVEI   A,2             ; ROOM FOR ! AND <
2630         PUSHJ   P,RETIF
2631         MOVEI   A,"!
2632         PUSHJ   P,PITYO
2633
2634 PLMNT5: MOVE    B,-2(TP)        ; GET CHANNEL FOR B
2635         PUSHJ   P,RETIF1
2636         MOVEI   A,"<
2637         PUSHJ   P,PITYO
2638         PUSHJ   P,LSTPRT
2639         MOVEI   A,"!
2640         MOVE    B,-2(TP)                ; GET CHANNEL INTO B
2641         TLNE    FLAGS,SEGBIT    ;SKIP IF NOT SEGEMNT
2642         PUSHJ   P,PRETIF
2643         MOVEI   A,">
2644         PUSHJ   P,PRETIF
2645         JRST    PNEXT
2646
2647
2648 \f
2649 LSTPRT: SKIPN   C,(TP)
2650         POPJ    P,
2651         HLLZ    A,(C)   ;GET NEXT ELEMENT
2652         MOVE    B,1(C)
2653         HRRZ    C,(C)   ;CHOP THE LIST
2654         JUMPN   C,PLIST1
2655         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
2656         PUSH    TP,-3(TP)
2657         PUSHJ   P,IPRINT        ;PRINT THE LAST ELEMENT
2658         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
2659         POPJ    P,
2660
2661 PLIST1: MOVEM   C,(TP)
2662         PUSH    TP,-3(TP)       ; GET CHANNEL FOR IPRINT
2663         PUSH    TP,-3(TP)
2664         PUSHJ   P,IPRINT        ;PRINT THE NEXT ELEMENT
2665         SUB     TP,[2,,2]       ; POP CHANNEL OFF STACK
2666         MOVE    B,-2(TP)        ; GET CHANNEL INTO B
2667         PUSHJ   P,SPACEQ
2668         JRST    LSTPRT  ;REPEAT
2669
2670 PNEXT:  POP     P,FLAGS ;RESTORE PREVIOUS FLAG BITS
2671         SUB     TP,[2,,2]       ;REMOVE INPUT ELEMENT FROM TP-STACK
2672         POP     P,C     ;RESTORE REG C
2673         POPJ    P,
2674
2675 OPENIT: PUSH    P,A
2676         PUSH    P,B
2677         PUSH    P,C
2678         PUSH    P,D
2679         PUSH    P,FLAGS
2680         PUSHJ   P,OPNCHN
2681         POP     P,FLAGS
2682         POP     P,D
2683         POP     P,C
2684         POP     P,B
2685         POP     P,A
2686         JUMPGE  B,FNFFL         ;ERROR IF IT CANNOT BE OPENED
2687         HRRZ    E,-2(B)
2688         POPJ    P,
2689
2690
2691 END
2692 \f