A large commit.
[pdp8.git] / sw / kermit / hachti / K12IPG.PA
diff --git a/sw/kermit/hachti/K12IPG.PA b/sw/kermit/hachti/K12IPG.PA
new file mode 100644 (file)
index 0000000..75ea7ed
--- /dev/null
@@ -0,0 +1,348 @@
+/      IPL GENERATING PROGRAM
+
+/      LAST EDIT:      08-OCT-1991     12:00:00        CJL
+
+/      MUST BE ASSEMBLED WITH '/F' SWITCH SET.
+
+/      THIS  IS  A  UTILITY  NAMED  IPLGEN  (AKA  K12IPG) TO CREATE  FIELD0.IPL  (AKA
+/      K12FL0.IPL)  AND  FIELD1.IPL (AKA K12FL1.IPL).  THESE FILES ARE IN TURN  MEANT
+/      FOR USE WITH THE DIRECT LOADING PROGRAM IPLOAD (AKA K12IPL).  FUTURE  VERSIONS
+/      OF K12MIT.SV MAY "GROW" TO USE FIELD TWO, IN WHICH CASE THIS PROGRAM WILL HAVE
+/      TO BE CHANGED.
+
+/      THIS PROGRAM ALWAYS RESIDES IN THE NEXT FIELD  BEYOND  K12MIT.SV,  AND CREATES
+/      FILES FOR ALL FIELDS LOWER THAN ITS LOADING FIELD.   THIS CURRENTLY REQUIRES A
+/      12K MACHINE TO ENCODE ALL LOCATIONS 00000-07577 AND 10000-17577.
+
+/      USAGE:
+
+/      SINCE K12MIT.SV IS A COMPLETE IMAGE FILE, IT MUST BE  LOADED  FIRST  IN  IMAGE
+/      MODE, AND THEN OVERLAYED WITH THE BINARY OF THIS ASSEMBLY:
+
+/      .PAL IPLGEN<IPLGEN/E/F                  ASSEMBLE IPLGEN PROGRAM.
+
+/      .LOAD K12MIT.SV/I$*IPLGEN/G=20200       LOAD K12MIT.SV IN IMAGE MODE;  THE $
+/                                              INDICATES USING <ESC> TO TERMINATE
+/                                              THE LINE; THEN LOAD IPLGEN AND START.
+
+/      THE  FILES  SYS:FIELD0.IP AND SYS:FIELD1.IP WILL BE CREATED  AND  THE  PROGRAM
+/      EXITS TO THE KEYBOARD MONITOR.  THE RESULTANT FILES  MAY  BE EDITED AS LONG AS
+/      THE  RULES  OF  .IPL FORMAT ENCODING ARE OBEYED (ADDITIONAL LOWER-CASE  LEADER
+/      COMMENTS  SHOULD  BE ADDED AT THE BEGINNING, AND UNRESTRICTED COMMENTS AT  THE
+/      END).
+
+/      ERROR MESSAGES:
+
+/      ERROR NUMBER            PROBABLE CAUSE
+
+/      5                       ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
+
+/      6                       OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
+
+/      7                       ERROR WHILE CLOSING THE OUTPUT FILE.
+
+/      8                       I/O ERROR WHILE ENCODING FILE DATA.
+\f/     EQUATED SYMBOLS.
+
+       CLOSE=  4                       /CLOSE OUTPUT FILE
+       DFIELD= 2                       /PROGRAM LOADS INTO FIELD TWO (ALSO OUTPUT COUNT)
+       DFLD=   DFIELD^10               /PROGRAM FIELD FOR CDF INSTRUCTIONS
+       ENTER=  3                       /ENTER TENTATIVE FILE
+       NL0001= CLA IAC                 /LOAD AC WITH 0001
+       NL0002= CLA CLL CML RTL         /LOAD AC WITH 0002
+       NL7777= CLA CMA                 /LOAD AC WITH 7777
+       SBOOT=  7600                    /MONITOR EXIT
+       SYSENTR=7607                    /CALL SYS: HANDLER HERE
+       USERROR=7                       /USER SIGNALLED ERROR
+       USRENT= 7700                    /USR ENTRY POINT WHEN NON-RESIDENT
+       USRFLD= 10                      /USR FIELD
+       WRITE=  4000                    /I/O WRITE BIT
+\f      FIELD   DFIELD                  /WHERE WE LOAD
+
+       *20                             /GET PAST AUTO-INDEX AREA
+
+BUFPTR,        .-.                             /OUTPUT BUFFER POINTER
+DANGCNT,.-.                            /DANGER COUNT FOR OUTPUT FILE
+FCNT,  -DFIELD                         /FIELD, FILE COUNTER
+FNAME, FILENAM FIELD0.IP               /OUTPUT FILE NAME FIELD
+LATEST,        .-.                             /LATEST OUTPUT CHARACTER
+OUTRECO,.-.                            /OUTPUT RECORD
+SCRCASE,.-.                            /CURRENT MESSAGE CASE
+SCRCHAR,.-.                            /LATEST MESSAGE CHARACTER
+SCRPTR,        .-.                             /MESSAGE POINTER
+TEMPTR,        .-.                             /TEMPORARY OUTPUT POINTER
+WRDADR,        .-.                             /WORD ADDRESS
+WRDCNT,        .-.                             /WORD COUNTER
+
+DSETUP,        .-.                             /DATA FIELD SETUP
+DATFLD,        CDF     00+.-.                  /WILL BE LATEST DATA FIELD
+       JMP I   DSETUP                  /RETURN TO CALLER
+\f      PAGE                            /START AT THE BEGINNING
+
+BEGIN, NOP                             /IN CASE WE'RE CHAINED TO
+LOOP,  TAD     (FNAME)                 /POINT TO
+       DCA     ENTAR1                  /STORED FILENAME
+       DCA     ENTAR2                  /CLEAR SECOND ARGUMENT
+       NL0001                          /SYS: IS ALWAYS DEVICE ONE
+       CDF     DFLD                    /INDICATE OUR CALLING FIELD
+       CIF     USRFLD                  /GOTO USR FIELD
+       JMS I   (USRENTRY)              /CALL USR ROUTINE
+       ENTER                           /ENTER TENTATIVE FILENAME
+ENTAR1,        .-.                             /WILL POINT TO FILENAME
+ENTAR2,        .-.                             /WILL BE ZERO
+       JMP     ENTERR                  /ENTER ERROR
+       TAD     ENTAR1                  /GET RETURNED FIRST RECORD
+       DCA     OUTRECORD               /STORE IT
+       TAD     ENTAR2                  /GET RETURNED EMPTY LENGTH
+       IAC                             /ADD 2-1 FOR OS/278 CRAZINESS
+       DCA     DANGCNT                 /STORE AS DANGER COUNT
+       NL7777                          /INDICATE INITIALIZATION
+       JMS I   [PUTBYTE]               /INITIALIZE OUTPUT FILE
+       JMS     LEADER                  /OUTPUT LEADER
+       JMS I   (DOFLD)                 /OUTPUT LATEST FIELD'S DATA
+       JMS     TRAILER                 /OUTPUT TRAILER
+       TAD     ("Z&37)                 /GET <^Z>
+CLOSLUP,JMS I  [PUTBYTE]               /OUTPUT A BYTE (^Z OR NULL)
+       TAD     BUFPTR                  /GET THE OUTPUT BUFFER POINTER
+       TAD     (-OUTBUFFER)            /COMPARE TO RESET VALUE
+       SZA CLA                         /SKIP IF IT MATCHES
+       JMP     CLOSLUP                 /ELSE KEEP GOING
+       NL0001                          /GET SYS:'S DEVICE NUMBER
+       CDF     DFLD                    /INDICATE OUR CALLING FIELD
+       CIF     USRFLD                  /GOTO USR FIELD
+       JMS I   (USRENTRY)              /CALL USR ROUTINE
+       CLOSE                           /CLOSE OUTPUT FILE
+       FNAME                           /POINTER TO FILENAME
+OUTCNT,        .-.                             /WILL BE ACTUAL COUNT
+       JMP     CLSERR                  /CLOSE ERROR
+       ISZ     FNAME+2                 /BUMP THE FILENAME
+       TAD     DATFLD                  /GET CURRENT DATA FIELD
+       TAD     (10)                    /BUMP TO NEXT FIELD
+       DCA     DATFLD                  /STORE BACK
+       ISZ     FCNT                    /DONE ALL FIELDS YET?
+       JMP     LOOP                    /NO, GO DO IT AGAIN
+       CIF CDF 00                      /YES, GOTO MONITOR FIELD
+       JMP I   [SBOOT]                 /EXIT TO MONITOR
+\f/     ERROR WHILE OUTPUTTING THE FILE.
+
+PROCERR,NL0002                         /SET INCREMENT
+       SKP                             /DON'T USE NEXT
+
+/      ERROR WHILE CLOSING THE OUTPUT FILE.
+
+CLSERR,        NL0001                          /SET INCREMENT
+       SKP                             /DON'T CLEAR IT
+
+/      OUTPUT FILE TOO LARGE ERROR.
+
+SIZERR,        CLA                             /CLEAN UP
+       TAD     (3)                     /SET INCREMENT
+       SKP                             /DON'T USE NEXT
+
+/      ENTER ERROR.
+
+ENTERR,        NL0002                          /SET INCREMENT
+       TAD     (3)                     /ADD ON OFFSET
+       DCA     ERRNUMBER               /STORE ERROR NUMBER
+       CDF     DFLD                    /ENSURE OUR FIELD
+       CIF     USRFLD                  /GOTO USR FIELD
+       JMS I   (USRENTRY)              /CALL USR ROUTINE
+       USERROR                         /USER ERROR
+ERRNUMB,.-.                            /WILL BE PASSED ERROR NUMBER
+\f/     LEADER ROUTINE.
+
+LEADER,        .-.                             /LEADER ROUTINE
+       JMS I   (SCRIBE)                /CALL SCRIBE ROUTINE
+       LEADMSG                         /FOR LEADER MESSAGE
+       TAD     DATFLD                  /GET CURRENT FIELD
+       RTR;RAR                         /MOVE DOWN
+       AND     (7)                     /JUST FIELD NUMBER
+       TAD     (NTABLE)                /POINT TO TABLE ELEMENT
+       DCA     MSGPTR                  /STASH THE POINTER
+       TAD I   MSGPTR                  /GET THE MESSAGE ADDRESS
+       DCA     MSGPTR                  /STORE IN-LINE
+       JMS I   (SCRIBE)                /CALL SCRIBE ROUTINE
+MSGPTR,        .-.                             /WILL POINT TO CORRECT MESSAGE
+       JMP I   LEADER                  /RETURN
+
+/      TRAILER ROUTINE.
+
+TRAILER,.-.                            /TRAILER ROUTINE
+       JMS I   (SCRIBE)                /CALL SCRIBE ROUTINE
+       SAVEMSG                         /END OF FILE MESSAGE
+       JMS     OUTFLD                  /OUTPUT FIELD DIGIT
+       JMS I   (SCRIBE)                /CALL SCRIBE ROUTINE
+       SVMSG                           /.SV BRIDIGING MESSAGE
+       JMS     OUTFLD                  /OUTPUT FIELD DIGIT
+       JMS I   (SCRIBE)                /CALL SCRIBE ROUTINE
+       SV0MSG                          /0000 BRIDGING MESSAGE
+       JMS     OUTFLD                  /OUTPUT FIELD DIGIT
+       JMS I   (SCRIBE)                /CALL SCRIBE ROUTINE
+       SVEMSG                          /FINISHING MESSAGE
+       JMP I   TRAILER                 /RETURN
+
+OUTFLD,        .-.                             /OUTPUT FIELD DIGIT ROUTINE
+       TAD     DATFLD                  /GET OUTPUT FIELD
+       RTR;RAR                         /MOVE OVER
+       AND     (7)                     /JUST FIELD DIGIT
+       TAD     ("0&177)                /MAKE IT ASCII
+       JMS I   [PUTBYTE]               /OUTPUT IT
+       JMP I   OUTFLD                  /RETURN
+
+       PAGE
+\fDOFLD,        .-.                             /DO LATEST FIELD ROUTINE
+       DCA     WRDADR                  /CLEAR WORD ADDRESS
+       TAD     (-7600)                 /SETUP THE
+       DCA     WRDCNT                  /WORD COUNT
+WRDLUP,        JMS     DSETUP                  /GOTO DATA FIELD
+       TAD I   WRDADR                  /GET A WORD
+       DCA     DSETUP                  /SAVE IT
+       CDF     DFLD                    /BACK TO OUR FIELD
+       TAD     DSETUP                  /GET THE WORD AGAIN
+       RTR;RTR;RTR                     /WANT HIGH-ORDER HALF FIRST
+       JMS     DOBYTE                  /OUTPUT HIGH-ORDER BYTE
+       TAD     DSETUP                  /GET THE WORD AGAIN
+       JMS     DOBYTE                  /OUTPUT LOW-ORDER BYTE
+       ISZ     WRDADR                  /BUMP TO NEXT ADDRESS
+       TAD     WRDADR                  /GET LATEST ADDRESS
+       AND     (37)                    /JUST LOW-ORDER BITS
+       SNA CLA                         /SKIP IF NOT AT GOOD BOUNDARY
+       JMS     PUTCRLF                 /ELSE OUTPUT LINE BREAK
+       ISZ     WRDCNT                  /DONE ALL WORD YET?
+       JMP     WRDLUP                  /NO, KEEP GOING
+       JMP I   DOFLD                   /YES, RETURN TO CALLER
+
+DOBYTE,        .-.                             /OUTPUT A SIX-BIT BYTE ROUTINE
+       AND     (77)                    /JUST SIX BITS
+       TAD     (41)                    /ADD ON OFFSET TO MAKE IT PRINTABLE
+       JMS I   [PUTBYTE]               /OUTPUT IT
+       JMP I   DOBYTE                  /RETURN
+\f/     <CR>/<LF> ROUTINE.
+
+PUTCRLF,.-.                            /OUTPUT <CR>/<LF> ROUTINE
+       TAD     ("M&37)                 /GET A <CR>
+       JMS I   [PUTBYTE]               /OUTPUT IT
+       TAD     ("J&37)                 /GET A <LF>
+       JMS I   [PUTBYTE]               /OUTPUT IT
+       JMP I   PUTCRLF                 /RETURN
+
+/      MESSAGE PRINT ROUTINE.
+
+SCRIBE,        .-.                             /MESSAGE PRINT ROUTINE
+       TAD I   SCRIBE                  /GET IN-LINE POINTER ARGUMENT
+       DCA     SCRPTR                  /STASH THE POINTER
+       ISZ     SCRIBE                  /BUMP PAST ARGUMENT
+       TAD     (140)                   /INITIALIZE TO
+       DCA     SCRCASE                 /LOWER-CASE
+SCRLUP,        TAD I   SCRPTR                  /GET LEFT HALF-WORD
+       RTR;RTR;RTR                     /MOVE OVER
+       JMS     SCRPRNT                 /PRINT IT
+       TAD I   SCRPTR                  /GET RIGHT HALF-WORD
+       JMS     SCRPRNT                 /PRINT IT
+       ISZ     SCRPTR                  /BUMP TO NEXT PAIR
+       JMP     SCRLUP                  /KEEP GOING
+
+SCRPRNT,.-.                            /CHARACTER PRINT ROUTINE
+       AND     (77)                    /JUST SIX BITS
+       SNA                             /END OF MESSAGE?
+       JMP I   SCRIBE                  /YES, RETURN TO ORIGINAL CALLER
+       DCA     SCRCHAR                 /NO, SAVE FOR NOW
+       TAD     SCRCHAR                 /GET IT BACK
+       TAD     (-"%!200)               /IS IT "%"?
+       SNA                             /SKIP IF NOT
+       JMP     SCRCRLF                 /JUMP IF IT MATCHES
+       TAD     (-"^+100+"%)            /IS IT "^"
+       SNA CLA                         /SKIP IF NOT
+       JMP     SCRFLIP                 /JUMP IF IT MATCHES
+       TAD     SCRCHAR                 /GET THE CHARACTER
+       AND     (40)                    /DOES CASE MATTER?
+       SNA CLA                         /SKIP IF NOT
+       TAD     SCRCASE                 /ELSE GET PREVAILING CASE
+       TAD     SCRCHAR                 /GET THE CHARACTER
+        JMS I  [PUTBYTE]               /OUTPUT THE CHARACTER
+       JMP I   SCRPRNT                 /RETURN
+
+SCRCRLF,JMS    PUTCRLF                 /OUTPUT <CR>/<LF>
+       JMP I   SCRPRNT                 /RETURN
+
+SCRFLIP,TAD    SCRCASE                 /GET CURRENT CASE
+       CIA                             /INVERT IT
+       TAD     (140+100)               /ADD SUM OF POSSIBLE VALUES
+       DCA     SCRCASE                 /STORE NEW INVERTED CASE
+       JMP I   SCRPRNT                 /RETURN
+\f      PAGE
+\fPUTBYTE,.-.                           /OUTPUT A BYTE ROUTINE
+       SPA                             /ARE WE INITIALIZING?
+       JMP     PUTINITIALIZE           /YES
+       AND     (177)                   /JUST IN CASE
+       DCA     LATEST                  /SAVE LATEST CHARACTER
+       TAD     LATEST                  /GET LATEST CHARACTER
+       JMP I   PUTNEXT                 /GO WHERE YOU SHOULD GO
+
+PUTNEXT,.-.                            /EXIT ROUTINE
+       JMP I   PUTBYTE                 /RETURN TO MAIN CALLER
+
+PUTINIT,CLA                            /CLEAN UP
+       TAD     OUTRECORD               /GET STARTING RECORD OF TENTATIVE FILE
+       DCA     PUTRECORD               /STORE IN-LINE
+       DCA I   (OUTCNT)                /CLEAR ACTUAL FILE LENGTH
+PUTNEWR,TAD    (OUTBUFFER)             /SETUP THE
+       DCA     BUFPTR                  /BUFFER POINTER
+PUTLOOP,JMS    PUTNEXT                 /GET A CHARACTER
+       DCA I   BUFPTR                  /STORE IT
+       TAD     BUFPTR                  /GET POINTER VALUE
+       DCA     TEMPTR                  /SAVE FOR LATER
+       ISZ     BUFPTR                  /BUMP TO NEXT
+       JMS     PUTNEXT                 /GET A CHARACTER
+       DCA I   BUFPTR                  /STORE IT
+       JMS     PUTNEXT                 /GET A CHARACTER
+       RTL;RTL                         /MOVE UP
+       AND     (7400)                  /ISOLATE HIGH NYBBLE
+       TAD I   TEMPTR                  /ADD ON FIRST BYTE
+       DCA I   TEMPTR                  /STORE COMPOSITE
+       TAD     LATEST                  /GET LATEST CHARACTER
+       RTR;RTR;RAR                     /MOVE UP AND
+       AND     (7400)                  /ISOLATE LOW NYBBLE
+       TAD I   BUFPTR                  /ADD ON SECOND BYTE
+       DCA I   BUFPTR                  /STORE COMPOSITE
+       ISZ     BUFPTR                  /BUMP TO NEXT
+       TAD     BUFPTR                  /GET LATEST POINTER VALUE
+       TAD     (-2^200-OUTBUFFER)      /COMPARE TO LIMIT
+       SZA CLA                         /SKIP IF AT END
+       JMP     PUTLOOP                 /KEEP GOING
+       ISZ     DANGCNT                 /TOO MANY RECORDS?
+       SKP                             /SKIP IF NOT
+       JMP I   (SIZERR)                /JUMP IF SO
+       CDF     DFLD                    /SET OUR FIELD
+       CIF     00                      /GOING TO SYSTEM FIELD
+       JMS I   (SYSENTRY)              /CALL I/O HANDLER
+       2^100+DFLD+WRITE                /WRITE SOME PAGES FROM OUTPUT BUFFER
+       OUTBUFFER                       /BUFFER ADDRESS
+PUTRECO,.-.                            /WILL BE LATEST RECORD NUMBER
+       JMP I   (PROCERR)               /OUTPUT ERROR!
+       ISZ I   (OUTCNT)                /BUMP ACTUAL LENGTH
+       ISZ     PUTRECORD               /BUMP TO NEXT RECORD
+       JMP     PUTNEWRECORD            /KEEP GOING
+\f      PAGE
+\f/     TEXT MESSAGES.
+
+LEADMSG,TEXT   "LEADER FOR DIRECT LOAD FILE WHICH MUST BE IN LOWER CASE%"
+       TEXT    "%FILE CONTAINS KERMIT DATA IN IPL ENCODED FORMAT%%"
+\f      TEXT    "THIS FILE CONTAINS DATA FOR FIELD"
+ONEMSG,        TEXT    " ONE%%^"
+SAVEMSG,TEXT   "END OF DATA%%^A^FTER THE PROGRAM EXITS BACK TO THE MONITOR, "
+\f      TEXT    "YOU SHOULD SAVE THE DATA WITH:%%.^SAVE SYS FIELD^"
+SVMSG, TEXT    ".^SV "
+SV0MSG,        TEXT    "0000-"
+SVEMSG,        TEXT    "7577=0%"
+ZEROMSG,TEXT   " ZERO%%"
+\f/     DIGIT MESSAGE POINTER TABLE.
+
+NTABLE,        ZEROMSG                         /POINTER TO ZERO MESSAGE
+       ONEMSG                          /POINTER TO ONE MESSAGE
+
+       PAGE                            /GET TO A GOOD BOUNDARY
+
+       OUTBUFF=.                       /OUTPUT BUFFER HERE
+
+       $                               /THAT'S ALL FOLK!