sumex/print.mcr246

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