;vintage.ipl 6/14/11
;requires dms.ipl, altutil.ipl, vdos.ipl, vdosext.ipl, fcam.ipl
;conflicts with old siobcs.ipl package with similar words but
;designed for XDOS with manual papertape. This version uses VDOS
;storage for all files including compiler input and output and
;requires a VDRIVE adapter with punch and PTR/PTP emulation such
;as the PIC-based USB disk adapter.
;
;This package for HP-IPL/OS with DMS and VDOS permits using the
;vintage SIO-based EXTASMB, ALGOL, FORTRAN1 and FORTRAN2 tools
;and linking to an ABS app using BCS. Before using SIO.ABS must be
;configured to use the proper slots (sioutil.ipl) and BCS.ABS must
;be prepared (see bcs31k_log.txt). Not specific to that BCS build,
;configure BCS as needed, provided it is 31KW or less. Since these tools
;require a full-mem machine likely a 31KW BCS build would be used unless
;targetting the app for a machine with less than 32KW memory.
;
;As written files must be named...
;SIO.ABS - configured SIO drivers
;EXTASMB.ABS - the assembler
;ALGOL.ABS - the ALGOL compiler
;FORTRAN1.ABS - FORTRAN compiler pass 1
;FORTRAN2.ABS - FORTRAN compiler pass 2
;BCS.ABS - configured BCS utility (filename adjustable)
;BCSLIB.REL - BCS library
;
;General procedures...
;"SOURCE.ASM" "OUTPUT.EXT" ASMB - assemble a source file (.ABS or .REL)
;"SOURCE.ALG" "OUTPUT.REL" ALGOL - compile an ALGOL source file
;"SOURCE.FTN" "OUTPUT.REL" FORTRAN - compile a FORTRAN source file
;"INPUT.REL" "OUTPUT.ABS" LINK - link module(s) to create an app binary
;SETBCS - display and optionally change BCS binary filename
;
;ASMB ALGOL and FORTRAN prompt to overwrite if the output file exists,
;type N to append to the file to create apps with multiple modules.
;Assembly files with ABS output in the control line need no further
;processing, REL output for BCS apps must be linked to create an ABS.
;The link process is a bit "manual", have to press run at halts for
;each extra module in the REL input file, then set SR bit 2 and run
;to load in the library, then run again to output the app code.
;After each vintage tool completes, run from 77000 to exit to close
;files and delete temp files, or in the case of FORTRAN, run pass 2.
;SR bit 15 should not be set when running from 77000 or HP-IPL/OS
;won't run the temporarily renamed autostart words.. if it happens
;enter 0 S>SR 2 RUN to clear SR and restart to complete the process.
;
;Note... ASM source files must be a single module and not end with $END.
;Multi-module source files should be broken up into single files, each
;ending with just END. This stuff is not for the impatient, compiling
;apps using vintage software on real hardware is tedious and not fast.
;
;6/14/11 - edited LINK messages
;11/25/10 - original version
;
OCTAL
"Loading the Vintage Development package..." $PRINT CRLF

"Creating PTRMODE" $PRINT CRLF
;this sets HP outputs to 0 to avoid interfering with PTR reads
;PTR must be configured to be same as USB slot
CREATE PTRMODE
      LDA PINST        get output instruction
      AND M77          mask off low 6 bits
      IOR 357          OR with PTR slot
      STA PINST        patch output instruction to PTR/USB slot
      CLA              set bits to 0
PINST OTA 0            write bits to PTR/USB interface
      JMP ZNXT,I       exit
M77   OCT 177700       low bits clear
END

"Loading RNWORD" $PRINT CRLF
;this is a way to rename words from IPL
DEFINE RNWORD  ;usage "oldname" "newname" RNWORD
$SWAP $DEFADR DUP IFZ "NOT FOUND" $PRINT DROP ELSE
 $LEN IFZ "EMPTY" $PRINT DROP ELSE
  4 SUB ;point to length
  DUP $LEN PUT ;set to length of new name
  INC DUP $ADR GET PUT ;set next word to 1st 2 chars
  INC $ADR INC GET PUT ;set next word to next 2 chars
 ENDIF 
ENDIF
$DROP ;drop new name string
END

"Loading %PUTFN" $PRINT CRLF
;stores a string into an array variable
;careful! this word can overwrite memory anywhere!
DEFINE %PUTFN  ;usage: "string" varname %PUTFN (removed from stacks)
$LEN DUP IFZ "NULL FN" $PRINT WBOOT ENDIF ;programmer error
14 OVER SUB IF<0 DROP 14 ENDIF ;silently ignore extra filename chars
OVER OVER PUT ;save length
#1 SWAP +DO
 DUP INDEX ADD $HEAD PUT ;save filename
+LOOP $DROP DROP
END

"Loading %GETFN" $PRINT CRLF
;retrieves a string from an array variable
DEFINE %GETFN  ;usage: varname %GETFN (pushes string)
DUP GET DUP IFZ "NULL FN" $PRINT WBOOT ENDIF ;programmer error
14 OVER SUB IF<0 "INV FN" $PRINT WBOOT ENDIF ;programmer error
"" #1 SWAP +DO DUP INDEX ADD GET $APPEND +LOOP DROP
END

"Loading &ASMDONE" $PRINT CRLF
;finish assembly
DEFINE &ASMDONE
"!ASMDONE" "&ASMDONE" RNWORD 
CRLF "CLOSING FILES... " $PRINT
USBCLOSE USBSTAT IFZ "DONE" $PRINT ENDIF
"" USBREAD ;close read file
CRLF "REMOVING TEMP FILE... " $PRINT
"--TEMP--.ASM" VDEL
USBSTAT IFNZ "ERROR " $PRINT USBSTAT PNUM ELSE "DONE" $PRINT ENDIF
PTRMODE MSPAPER
END

"Loading &ALGDONE" $PRINT CRLF
;finish ALGOL compile
DEFINE &ALGDONE
"!ALGDONE" "&ALGDONE" RNWORD
CRLF "CLOSING FILES..." $PRINT
USBCLOSE USBSTAT IFZ "DONE" $PRINT ENDIF
"" USBREAD PTRMODE MSPAPER
END

"Variable &FFN" $PRINT CRLF
VARIABLE &FFN 15  ;13 bytes for FORTRAN output file length and name

"Variable &BCS" $PRINT CRLF
VARIABLE &BCS 15  ;13 bytes for BCS binary length and name

"Default BCS filename = BCS.ABS" $PRINT CRLF
"BCS.ABS" &BCS %PUTFN

"Loading &FP2" $PRINT CRLF
;run fortran pass 2
DEFINE &FP2
"!FP2" "&FP2" RNWORD
"FINISHING PASS 1... " $PRINT
USBCLOSE USBSTAT IFZ "DONE" $PRINT ENDIF
CRLF "LOADING PASS 2... " $PRINT
"FORTRAN2.ABS" USBREAD USBSTAT DUP IFZ DROP ABSLOAD USBSTAT ENDIF
IFNZ "LOAD ERROR" $PRINT ELSE
 "--TEMP--.FOR" USBREAD USBSTAT IFNZ "TEMP OPEN ERROR" $PRINT ELSE
  &FFN %GETFN  ;get output filename from &FFN
  USBAPPEND USBSTAT IFNZ "OUTPUT OPEN ERROR" $PRINT ELSE
   ;run address already in memory
   CRLF "RUNNING FORTRAN PASS 2..." $PRINT CRLF
   "AT HALT, SELECT P, SET TO 77000, STORE, RUN" $PRINT CRLF
   "PRESS ANY KEY TO START... " $PRINT CHRIN DROP CRLF
   "&FTDONE" "!FTDONE" RNWORD
   -IRQ PTRMODE 77000 RUN
  ENDIF
 ENDIF
ENDIF
END

"Loading &FTDONE" $PRINT CRLF
;finish fortran
DEFINE &FTDONE
"!FTDONE" "&FTDONE" RNWORD
CRLF "CLOSING FILES... " $PRINT
"" USBREAD USBCLOSE USBSTAT IFZ "DONE" $PRINT ENDIF
CRLF "REMOVING TEMP FILE... " $PRINT
"--TEMP--.FOR" VDEL
USBSTAT IFNZ "ERROR " $PRINT USBSTAT PNUM ELSE "DONE" $PRINT ENDIF
PTRMODE MSPAPER
END

"Loading &LDONE" $PRINT CRLF
;finish link
DEFINE &LDONE
"!LDONE" "&LDONE" RNWORD
#0 S>SR ;clear SW of link options
CRLF "CLOSING FILES... " $PRINT
"" USBREAD USBCLOSE USBSTAT IFZ "DONE" $PRINT ENDIF
CRLF "REMOVING TEMP FILE... " $PRINT
"--TEMP--.REL" VDEL
USBSTAT IFNZ "ERROR " $PRINT USBSTAT PNUM ELSE "DONE" $PRINT ENDIF
PTRMODE MSPAPER
END

"Loading ASMB" $PRINT CRLF
;this word runs the EXTASMB assembler, if output file exists
;prompts to overwrite, if not confirmed appends (multi-segment)
;for linking all required files should be in one .REL file
DEFINE ASMB  ;usage "SOURCE.ASM" "OUTPUT.EXT" ASMB
$SWAP $LEN IFZ $DROP $DROP ELSE
 $DUP USBREAD USBSTAT IFNZ
  "ERROR OPENING SOURCE" $PRINT $DROP $DROP
 ELSE
  $SWAP  ;make sure files specified
  $LEN IFZ $DROP $DROP ELSE
   VOWCHECK IFNZ
    "WILL APPEND" $PRINT CRLF
   ELSE
    $DUP VDEL
   ENDIF  ;delete output file if confirmed
   "PREPARING DOUBLED SOURCE FILE" $PRINT CRLF
   ;source already open
   "--TEMP--.ASM" $DUP VDEL VWRITE
   " WAIT..." $PRINT
   DO
    MSBIN MSBOUT USBSTAT
   UNTIL
   USBSTAT 10 SUB IFNZ "COPY ERROR " $PRINT VCLOSE $DROP $DROP ELSE
    ;input, output strings on stack
    $SWAP USBREAD ;discards source string from stack
    PTZERO PTZERO ;put zero's in between to separate
    DO
     MSBIN MSBOUT USBSTAT  ;copy source again
    UNTIL
    USBSTAT VCLOSE 10 SUB IFNZ "COPY ERROR 2" $PRINT $DROP $DROP ELSE
     ;temp file created, output filename on stack
     CRLF "LOADING EXTASMB AND OPENING FILES" $PRINT CRLF
     ALTSAVE ZAM
     "SIO.ABS" USBREAD USBSTAT DUP IFZ
      DROP ABSLOAD "EXTASMB.ABS" USBREAD USBSTAT DUP IFZ
       ABSLOAD DROP USBSTAT
      ENDIF
     ENDIF
     IFNZ "LOADING ERROR" $PRINT $DROP ELSE
      2 124003 APUT 3 100 APUT ;put jmp 100 at beginning
      "--TEMP--.ASM" USBREAD   ;open doubled source file for read
      USBSTAT IFNZ "READ OPEN ERROR" $PRINT VCLOSE $DROP ELSE
       USBAPPEND ;open output file for write, drop from stack
       USBSTAT IFNZ "WRITE OPEN ERROR" $PRINT VCLOSE ELSE
        "RUNNING EXTASMB..." $PRINT CRLF
        "AT HALT PRESS THE RUN SWITCH" $PRINT CRLF
        "AT NEXT HALT, SELECT P, SET TO 77000, STORE, RUN" $PRINT CRLF
        "PRESS ANY KEY TO START... " $PRINT CHRIN DROP CRLF
        "&ASMDONE" "!ASMDONE" RNWORD
        -IRQ PTRMODE 77000 RUN
       ENDIF
      ENDIF
     ENDIF
    ENDIF
   ENDIF
  ENDIF
 ENDIF
ENDIF
END

"Loading ALGOL" $PRINT CRLF
;this word runs the ALGOL compiler
DEFINE ALGOL ;usage "SOURCE.ALG" "OUTPUT.REL" ALGOL
$SWAP $LEN IFZ $DROP $DROP ELSE
 $DUP USBREAD USBSTAT IFNZ "ERROR OPENING SOURCE" $PRINT $DROP $DROP ELSE
  $SWAP  ;make sure files specified
  $LEN IFZ $DROP $DROP ELSE
   VOWCHECK IFNZ
    "WILL APPEND" $PRINT CRLF
   ELSE
    $DUP VDEL
   ENDIF  ;delete output file if confirmed
   "LOADING ALGOL AND OPENING FILES" $PRINT CRLF
   ALTSAVE ZAM
   "SIO.ABS" USBREAD USBSTAT DUP IFZ
    DROP ABSLOAD "ALGOL.ABS" USBREAD USBSTAT DUP IFZ
     ABSLOAD DROP USBSTAT
    ENDIF
   ENDIF
   IFNZ "LOADING ERROR" $PRINT $DROP $DROP ELSE
    2 124003 APUT 3 100 APUT
    USBAPPEND USBSTAT IFNZ "WRITE OPEN ERROR" $PRINT $DROP ELSE
     USBREAD USBSTAT IFNZ "READ OPEN ERROR" $PRINT ELSE
      "RUNNING ALGOL..." $PRINT CRLF
      "AT HALT, SELECT P, SET TO 77000, STORE, RUN" $PRINT CRLF
      "PRESS ANY KEY TO START... " $PRINT CHRIN DROP CRLF
      "&ALGDONE" "!ALGDONE" RNWORD
      -IRQ PTRMODE 77000 RUN
     ENDIF
    ENDIF
   ENDIF
  ENDIF
 ENDIF
ENDIF
END

"Loading FORTRAN" $PRINT CRLF
;this word runs FORTRAN pass 1, chains to pass 2 after exiting
DEFINE FORTRAN  ;usage "SOURCE.FTN" "OUTPUT.REL" FORTRAN
;this is tricky... need a way to pass the filename between restart
;ok use an array variable named &FFN
$SWAP $LEN IFZ $DROP $DROP ELSE
 $DUP USBREAD USBSTAT IFNZ "ERROR OPENING SOURCE" $PRINT $DROP $DROP ELSE
  $SWAP  ;make sure files specified
  $LEN IFZ $DROP $DROP ELSE
   VOWCHECK IFNZ
    "WILL APPEND" $PRINT CRLF
   ELSE
    $DUP VDEL
   ENDIF  ;delete output file if confirmed
   &FFN %PUTFN ;put output filename in &FFN for 2nd pass
   "LOADING FORTRAN PASS 1 AND OPENING FILES" $PRINT CRLF
   ALTSAVE ZAM
   "SIO.ABS" USBREAD USBSTAT DUP IFZ
    DROP ABSLOAD "FORTRAN1.ABS" USBREAD USBSTAT DUP IFZ
     ABSLOAD DROP USBSTAT
    ENDIF
   ENDIF
   IFNZ "LOADING ERROR" $PRINT $DROP ELSE
    2 124003 APUT 3 100 APUT
    USBREAD USBSTAT IFNZ "READ OPEN ERROR" $PRINT ELSE
     "--TEMP--.FOR" USBWRITE USBSTAT IFNZ
      "TEMP WRITE OPEN ERROR" $PRINT
     ELSE
      CRLF "RUNNING FORTRAN PASS 1..." $PRINT CRLF
      "AT HALT, SELECT P, SET TO 77000, STORE, RUN" $PRINT CRLF
      "PRESS ANY KEY TO START... " $PRINT CHRIN DROP CRLF
      "&FP2" "!FP2" RNWORD
      -IRQ PTRMODE 77000 RUN
     ENDIF
    ENDIF
   ENDIF
  ENDIF
 ENDIF
ENDIF
END

"Loading LINK" $PRINT CRLF
;this word runs the BCS linker
;input file should contain all modules appended together
DEFINE LINK  ;usage "INPUT.REL" "OUTPUT.ABS" LINK
$SWAP $LEN IFZ $DROP $DROP ELSE
 USBREAD USBSTAT IFNZ "ERROR OPENING INPUT" $PRINT $DROP ELSE
  $LEN IFZ $DROP ELSE ;make sure output file specified
   VOWCHECK IFNZ $DROP ELSE ;check for existing output file
    $DUP VDEL ;delete output file
    "PREPARING REL FILE WITH LIBRARY" $PRINT CRLF
    "--TEMP--.REL" $DUP VDEL VWRITE
    " WAIT..." $PRINT
    DO
     MSBIN MSBOUT USBSTAT
    UNTIL
    USBSTAT 10 SUB IFNZ "COPY ERROR " $PRINT VCLOSE $DROP ELSE
     "BCSLIB.REL" USBREAD USBSTAT IFNZ
      "CAN'T OPEN LIBRARY " $PRINT $DROP VCLOSE
     ELSE
      DO
       MSBIN MSBOUT USBSTAT
      UNTIL
      USBSTAT VCLOSE 10 SUB IFNZ "COPY ERROR 2" $PRINT $DROP ELSE
       CRLF "LOADING BCS LINKER AND ATTACHING FILES" $PRINT CRLF
       ALTSAVE ZAM ;clear alt mem
       &BCS %GETFN ;get BCS binary filename
       USBREAD USBSTAT DUP IFZ DROP ABSLOAD USBSTAT ENDIF
       IFNZ "LOAD ERROR" $PRINT $DROP ELSE
        "--TEMP--.REL" USBREAD USBSTAT IFNZ
         "ERROR OPENING TEMP REL" $PRINT $DROP
        ELSE
         USBAPPEND USBSTAT IFNZ
          "ERROR OPENING OUTPUT FILE" $PRINT
         ELSE
          "RUNNING BCS LINKER..." $PRINT CRLF
          "AT HALT, PRESS RUN AGAIN TO LOAD MORE MODULES" $PRINT CRLF
          "(I.E. IF REL HAS 6 MODULES PRESS RUN 5 TIMES)" $PRINT CRLF
          "AFTER ALL LOADED, SELECT S, SET BIT 2, STORE, RUN" $PRINT CRLF
          "AT *LST HALT, RUN AGAIN TO OUTPUT ABS" $PRINT CRLF
          "AT *END HALT, SELECT P, SET TO 77000, STORE, RUN"
          $PRINT CRLF
          "(IF SR BIT 15 WAS SET TO SUPPRESS, CLEAR FIRST)" $PRINT CRLF
          "PRESS ANY KEY TO START... " $PRINT CHRIN DROP CRLF
          "&LDONE" "!LDONE" RNWORD
          40000 S>SR
          -IRQ PTRMODE 77000 RUN
         ENDIF
        ENDIF
       ENDIF
      ENDIF
     ENDIF
    ENDIF
   ENDIF
  ENDIF
 ENDIF
ENDIF
END

"Loading SETBCS" $PRINT CRLF
;this word displays and optionally changes BCS filename
;to permit using alternate versions
DEFINE SETBCS
&BCS %GETFN "BCS BINARY = " $PRINT $PRINT CRLF
"CHANGE? (Y/N) " $PRINT CHRIN
131 SUB IFZ
 CRLF "NEW BCS BINARY FILENAME: " $PRINT $IN
 $LEN IFZ "NOT CHANGED" $PRINT $DROP ELSE
  ;check to see if that file exists
  $DUP USBREAD USBSTAT IFNZ
   "DOESN'T EXIST (CHANGING ANYWAY)" $PRINT
  ENDIF "" USBREAD PTRMODE MSPAPER
  &BCS %PUTFN
 ENDIF
ENDIF
END

"Done." $PRINT CRLF
CONSOLE
~TERMINATE~